von delta9 » Fr, 26.03.2010 07:59
Ich habe genau die Zeilen genommen, wie du geschrieben hast. Demnach muss MyTextRange ja ein Nullobjekt sein?
Schicke mir doch mal Deine Code, bei dem es funktioniert.
Unten mein Code.
Stefan
Code: Alles auswählen
option explicit
sub aufnehmen
aufnehmen1(0)
end sub
sub loeschen
aufnehmen1("Bausteine Energie1")
end sub
sub aufnehmen1(Loeschname)
' *********************************
' * Sucht Texteinträge für autotext
' Aufbau:
' Nur Zeilen, die mit * anfangen, haben einen Eintrag
' der Aufrbau ist wie Folgt:
' *_Tabulator_Kürzel_Tabulator_Eingtag bis Absatzende (Unterstriche exitsieren nicht)
' Wenn nur Loeschname, dann wird nur diese Gruppe gelöscht
' Endet bei MArke STOPP Tab Text Tab Text
' *********************************
dim nur_loeschen as boolean
if Loeschname = 0 then
nur_loeschen = false
else
nur_loeschen = true
end if
const MaxAbsatzZahl = 1000
Const GruppenNameAutotext = "Bausteine Energie"
dim NameAutoGruppe
dim quelldatei as object ' Blatt, in dem die Autotextdaten stehen
Dim oText
Dim i
dim AbsatzZaehler
dim zeichen as string
dim AbsatzCursor
dim eintragzaehler ' Anzah der gefundenen Einträge
dim PosErstzeichen as integer ' Nummer des ersten Zeichens des Textabuseins (nach Stern und Kürzel)
dim Kuerzel as string
dim textbaustein as object
dim s1
dim oAutoTextContainer
dim oAutoGroup
dim AutotextBaustein
dim oAutoGroupIndex
dim Eintragname as string
dim fehlertext as string
' Initialisieren
if nur_loeschen then
NameAutoGruppe = loeschname
else
NameAutoGruppe = GruppenNameAutotext
end if
quelldatei = thiscomponent
oText = quelldatei.Text
AbsatzCursor = oText.CreateTextCursor()
AbsatzCursor.GoToStart(False)
oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer")
eintragzaehler = 0
dim gefunden
dim oProgressbar
oProgressbar = ThisComponent.GetCurrentController.GetFrame.CreateStatusIndicator
oProgressbar.setText("Start Mustertexte Lesen", 100 )
gefunden = false
for i= 0 to oAutoTextContainer.count-1 ' contanier suchen
' msgbox "Container: ( " & I & ") : =" & oAutoTextContainer.GetByIndex(i).Title
If oAutoTextContainer.GetByIndex(i).Title = NameAutoGruppe then
oAutoGroupIndex = i
gefunden = True
end if
next i
if gefunden = false then
Msgbox "Autotextgruppe: '" & NameAutoGruppe & "' nicht gefunden."
if nur_loeschen then
msgbox "Zu loeschender Bautsein:: " & NameAutoGruppe & " nicht gefunden"
exit sub
endif
oautoTextcontainer.insertNewByName NameAutoGruppe
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' neu erzeugt."
oProgressbar.setText ( "Autotextgruppe: '" & NameAutoGruppe & "' neu erzeugt.", 100)
else
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' gefunden."
if oAutoTextContainer.count < 1 then ' füllen um zu löschen, sonst gehts nicht
msgbox "Autotextgruppe: '" & NameAutoGruppe & " war leer."
AbsatzCursor.gotoNextParagraph(True)
AbsatzCursor.gotoNextParagraph(True)
AbsatzCursor.gotoNextParagraph(True)
oAutoGroup.insertNewByName ( "dummy", "dummychen", AbsatzCursor)
end if
'GOTO XXX
oAutoGroup = oAutoTextContainer.GetByName (NameAutoGruppe )
dim b
do while oAutoGroup.haselements
b = oAutoGroup.elementnames(0)
xray.xray oAutoGroup.getbyname (b)
' oAutoGroup.getbyname (b).implementationname = "SwXAutoTextEntry"
oProgressbar.SetText("Löschen " & b , 100 )
oAutoGroup.removeByname (b)
loop
XXX:
oautoTextcontainer.removeByName NameAutoGruppe
if nur_loeschen then
msgbox "Zu loeschender Bautsein: " & NameAutoGruppe & " geloescht"
exit sub
end if
oautoTextcontainer.insertNewByName NameAutoGruppe
oProgressbar.setText ( "Autotextgruppe: '" & NameAutoGruppe & "' gelöscht und neu erzeugt.", 100)
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' gelöscht und neu erzeugt"
end if
oAutoGroup = oAutoTextContainer.GetByName (NameAutoGruppe)
' Das es offensichtlich nicht reicht, den Textbausteincontainer zu löschen,müssen alle eventuellen Einträge gelöscht werden:
oProgressbar.SetText("Löschen Vorhandener Einträge", 100 )
dim a
do while oAutoGroup.haselements
a = oAutoGroup.elementnames(0)
oProgressbar.SetText("Löschen " & a , 100 )
oAutoGroup.removeByname (a)
loop
'Schleife durch Absätze *************************************************
oProgressbar.SetText("Start Schleife", 100 )
AbsatzZaehler = 0
Do While AbsatzCursor.gotoNextParagraph(True)
zeichen = left(AbsatzCursor.String,1)
if zeichen = "*" then
' msgboy "gefunden: " & AbsatzCursor.String
rausziehen(AbsatzCursor.String, PosErstzeichen, kuerzel)
If PosErstzeichen <= 0 then
select case PosErstzeichen
case -1: Fehlertext = "FEHLER: Leerzeichen im Kürzel in: " & chr(13) & AbsatzCursor.String
case -2: Fehlertext = "FEHLER" & chr(13) & "Erster Tabulator fehlt in: " & chr(13) & AbsatzCursor.String
case -3: Fehlertext= "FEHLER" & chr(13) & "Zweiter Tabulator fehlt in: " & chr(13) & AbsatzCursor.String
case else: Fehlertext = "FEHLER SONST poserstzeichen = " & PosErstzeichen & " in: " & chr(13) & AbsatzCursor.String
end select
msgbox fehlertext
else
AbsatzCursor.collapsetostart()
AbsatzCursor.goRight(PosErstzeichen-1,false)
AbsatzCursor.gotoEndOfParagraph(True)
' msgbox "Gefunden" & chr(13) & "Tabulator in Pos: " & Poserstzeichen & chr(13) _
' & "ausgewertet: " & AbsatzCursor.string & chr(13) & "Kürzel: " & Kuerzel
Eintragname = kuerzel ' & " " & AbsatzCursor.string
' on error goto kuerzelfehler
' AbsatzCursor.ParaStyleName= "_Musterabsatz"
'**********
dim AbsatzCursorX
AbsatzCursorX = oText.CreateTextCursor()
dim MyTextRange
MyTextRange = CreateUnoService("com.sun.star.text.TextRange")
'MyTextRange = AbsatzCursor
'xray.xray MyTextRange
'MyTextRange.String = "OTTO"
MyTextRange.String = AbsatzCursor.String
'**********
'AbsatzCursorX.string = AbsatzCursor.string
oAutoGroup.insertNewByName( Kuerzel, Eintragname, MyTextRange)
'oAutoGroup.insertNewByName( Kuerzel, Eintragname, MyTextRange )
' oAutoGroup.insertNewByName ( Kuerzel, Eintragname, AbsatzCursor)
on error goto 0
'
' xray.xray oAutoGroup' .getbyindex(oAutoGroup.count-1)
' dim c
' c = oAutoGroup.getbyindex(oAutoGroup.count-1)
' c.start.parastylename = "Standard"
eintragzaehler = eintragzaehler +1
oProgressbar.SetText("Eingetragen: " & eintragzaehler & " " & Kuerzel, 100 )
goto weiter
kuerzelfehler:
msgbox "Fehler bei Kürzel: " & Kuerzel &chr(13) & "Kürzel doppelt vergeben?"
on error goto 0
weiter:
AbsatzCursor.collapsetoend()
AbsatzCursor.GoRight(1,false)
AbsatzZaehler = AbsatzZaehler +1
if AbsatzZaehler > MaxAbsatzZahl then
msgbox "Ende nicht gefunden nach " & MaxAbsatzZahl & " Absätzen"
exit do
end if
end if ' PosErstzeichen <= 0
else
AbsatzCursor.collapsetoend()
' AbsatzCursor.GoRight(1,false)
AbsatzZaehler = AbsatzZaehler +1
if AbsatzZaehler > MaxAbsatzZahl then
msgbox "Ende nicht gefunden nach " & MaxAbsatzZahl & " Absätzen"
exit do
end if
end if ' Zeichen = "*"
' msgbox "AbsatzZaehler: " & AbsatzZaehler & " Kuerzel:" & Kuerzel & " Zeichen = " & Zeichen
IF KUERZEL = "STOPP" then
msgbox "Stoppmarke gefunden"
exit do
end if
Loop
msgbox "Fertig! " & eintragzaehler & " Einträge gefunden."
end sub
sub rausziehen(prueftext, PosErstzeichen as integer, kuerzel as string) as string
' ***************************************
' liefert das Kürzel das ein Leezeichen nach dem dritten Zeichen beginn
' PosErstzeichen = die Position, wo der Autotexteeingtrag begeinnt
' Dies ist der Text nach dem Tabulatuor
' PosErstzeichen = -1 , wenn Leerzeichen im Kürzel enthalten ist
' PosErstzeichen = -2 , wenn erster Tabulator fehlt
' PosErstzeichen = -3 , wenn zweiter Tabulator fehlt
' ***************************************
dim i as integer
dim zeichen as string
PosErstzeichen = 0
zeichen = mid(prueftext,2,1)
if asc(zeichen) <> 9 then
PosErstzeichen = -2
exit sub
end if
i = 2
do while i < len(prueftext)
i = i +1
zeichen = mid(prueftext,i,1)
'msgboy "prüftext: " & prueftext & "zeichen(" & i & ") = " & zeichen & " acs= " & asc(zeichen)
' if asc(zeichen) = 32 then
' PosErstzeichen = -1
' exit do
' end if
if asc(zeichen) = 9 then
PoserstZeichen = i + 1 ' Tabulator nicht mitzählen
exit do
end if
loop
if i >= len(prueftext) then PosErstzeichen = -3
kuerzel = mid(prueftext,3,PosErstzeichen-2-2)
if instr(kuerzel," ") <> 0 then PosErstzeichen = -1
end sub
sub test
end sub
Ich habe genau die Zeilen genommen, wie du geschrieben hast. Demnach muss MyTextRange ja ein Nullobjekt sein?
Schicke mir doch mal Deine Code, bei dem es funktioniert.
Unten mein Code.
Stefan
[code]
option explicit
sub aufnehmen
aufnehmen1(0)
end sub
sub loeschen
aufnehmen1("Bausteine Energie1")
end sub
sub aufnehmen1(Loeschname)
' *********************************
' * Sucht Texteinträge für autotext
' Aufbau:
' Nur Zeilen, die mit * anfangen, haben einen Eintrag
' der Aufrbau ist wie Folgt:
' *_Tabulator_Kürzel_Tabulator_Eingtag bis Absatzende (Unterstriche exitsieren nicht)
' Wenn nur Loeschname, dann wird nur diese Gruppe gelöscht
' Endet bei MArke STOPP Tab Text Tab Text
' *********************************
dim nur_loeschen as boolean
if Loeschname = 0 then
nur_loeschen = false
else
nur_loeschen = true
end if
const MaxAbsatzZahl = 1000
Const GruppenNameAutotext = "Bausteine Energie"
dim NameAutoGruppe
dim quelldatei as object ' Blatt, in dem die Autotextdaten stehen
Dim oText
Dim i
dim AbsatzZaehler
dim zeichen as string
dim AbsatzCursor
dim eintragzaehler ' Anzah der gefundenen Einträge
dim PosErstzeichen as integer ' Nummer des ersten Zeichens des Textabuseins (nach Stern und Kürzel)
dim Kuerzel as string
dim textbaustein as object
dim s1
dim oAutoTextContainer
dim oAutoGroup
dim AutotextBaustein
dim oAutoGroupIndex
dim Eintragname as string
dim fehlertext as string
' Initialisieren
if nur_loeschen then
NameAutoGruppe = loeschname
else
NameAutoGruppe = GruppenNameAutotext
end if
quelldatei = thiscomponent
oText = quelldatei.Text
AbsatzCursor = oText.CreateTextCursor()
AbsatzCursor.GoToStart(False)
oAutoTextContainer = CreateUnoService("com.sun.star.text.AutoTextContainer")
eintragzaehler = 0
dim gefunden
dim oProgressbar
oProgressbar = ThisComponent.GetCurrentController.GetFrame.CreateStatusIndicator
oProgressbar.setText("Start Mustertexte Lesen", 100 )
gefunden = false
for i= 0 to oAutoTextContainer.count-1 ' contanier suchen
' msgbox "Container: ( " & I & ") : =" & oAutoTextContainer.GetByIndex(i).Title
If oAutoTextContainer.GetByIndex(i).Title = NameAutoGruppe then
oAutoGroupIndex = i
gefunden = True
end if
next i
if gefunden = false then
Msgbox "Autotextgruppe: '" & NameAutoGruppe & "' nicht gefunden."
if nur_loeschen then
msgbox "Zu loeschender Bautsein:: " & NameAutoGruppe & " nicht gefunden"
exit sub
endif
oautoTextcontainer.insertNewByName NameAutoGruppe
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' neu erzeugt."
oProgressbar.setText ( "Autotextgruppe: '" & NameAutoGruppe & "' neu erzeugt.", 100)
else
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' gefunden."
if oAutoTextContainer.count < 1 then ' füllen um zu löschen, sonst gehts nicht
msgbox "Autotextgruppe: '" & NameAutoGruppe & " war leer."
AbsatzCursor.gotoNextParagraph(True)
AbsatzCursor.gotoNextParagraph(True)
AbsatzCursor.gotoNextParagraph(True)
oAutoGroup.insertNewByName ( "dummy", "dummychen", AbsatzCursor)
end if
'GOTO XXX
oAutoGroup = oAutoTextContainer.GetByName (NameAutoGruppe )
dim b
do while oAutoGroup.haselements
b = oAutoGroup.elementnames(0)
xray.xray oAutoGroup.getbyname (b)
' oAutoGroup.getbyname (b).implementationname = "SwXAutoTextEntry"
oProgressbar.SetText("Löschen " & b , 100 )
oAutoGroup.removeByname (b)
loop
XXX:
oautoTextcontainer.removeByName NameAutoGruppe
if nur_loeschen then
msgbox "Zu loeschender Bautsein: " & NameAutoGruppe & " geloescht"
exit sub
end if
oautoTextcontainer.insertNewByName NameAutoGruppe
oProgressbar.setText ( "Autotextgruppe: '" & NameAutoGruppe & "' gelöscht und neu erzeugt.", 100)
msgbox "Autotextgruppe: '" & NameAutoGruppe & "' gelöscht und neu erzeugt"
end if
oAutoGroup = oAutoTextContainer.GetByName (NameAutoGruppe)
' Das es offensichtlich nicht reicht, den Textbausteincontainer zu löschen,müssen alle eventuellen Einträge gelöscht werden:
oProgressbar.SetText("Löschen Vorhandener Einträge", 100 )
dim a
do while oAutoGroup.haselements
a = oAutoGroup.elementnames(0)
oProgressbar.SetText("Löschen " & a , 100 )
oAutoGroup.removeByname (a)
loop
'Schleife durch Absätze *************************************************
oProgressbar.SetText("Start Schleife", 100 )
AbsatzZaehler = 0
Do While AbsatzCursor.gotoNextParagraph(True)
zeichen = left(AbsatzCursor.String,1)
if zeichen = "*" then
' msgboy "gefunden: " & AbsatzCursor.String
rausziehen(AbsatzCursor.String, PosErstzeichen, kuerzel)
If PosErstzeichen <= 0 then
select case PosErstzeichen
case -1: Fehlertext = "FEHLER: Leerzeichen im Kürzel in: " & chr(13) & AbsatzCursor.String
case -2: Fehlertext = "FEHLER" & chr(13) & "Erster Tabulator fehlt in: " & chr(13) & AbsatzCursor.String
case -3: Fehlertext= "FEHLER" & chr(13) & "Zweiter Tabulator fehlt in: " & chr(13) & AbsatzCursor.String
case else: Fehlertext = "FEHLER SONST poserstzeichen = " & PosErstzeichen & " in: " & chr(13) & AbsatzCursor.String
end select
msgbox fehlertext
else
AbsatzCursor.collapsetostart()
AbsatzCursor.goRight(PosErstzeichen-1,false)
AbsatzCursor.gotoEndOfParagraph(True)
' msgbox "Gefunden" & chr(13) & "Tabulator in Pos: " & Poserstzeichen & chr(13) _
' & "ausgewertet: " & AbsatzCursor.string & chr(13) & "Kürzel: " & Kuerzel
Eintragname = kuerzel ' & " " & AbsatzCursor.string
' on error goto kuerzelfehler
' AbsatzCursor.ParaStyleName= "_Musterabsatz"
'**********
dim AbsatzCursorX
AbsatzCursorX = oText.CreateTextCursor()
dim MyTextRange
MyTextRange = CreateUnoService("com.sun.star.text.TextRange")
'MyTextRange = AbsatzCursor
'xray.xray MyTextRange
'MyTextRange.String = "OTTO"
MyTextRange.String = AbsatzCursor.String
'**********
'AbsatzCursorX.string = AbsatzCursor.string
oAutoGroup.insertNewByName( Kuerzel, Eintragname, MyTextRange)
'oAutoGroup.insertNewByName( Kuerzel, Eintragname, MyTextRange )
' oAutoGroup.insertNewByName ( Kuerzel, Eintragname, AbsatzCursor)
on error goto 0
'
' xray.xray oAutoGroup' .getbyindex(oAutoGroup.count-1)
' dim c
' c = oAutoGroup.getbyindex(oAutoGroup.count-1)
' c.start.parastylename = "Standard"
eintragzaehler = eintragzaehler +1
oProgressbar.SetText("Eingetragen: " & eintragzaehler & " " & Kuerzel, 100 )
goto weiter
kuerzelfehler:
msgbox "Fehler bei Kürzel: " & Kuerzel &chr(13) & "Kürzel doppelt vergeben?"
on error goto 0
weiter:
AbsatzCursor.collapsetoend()
AbsatzCursor.GoRight(1,false)
AbsatzZaehler = AbsatzZaehler +1
if AbsatzZaehler > MaxAbsatzZahl then
msgbox "Ende nicht gefunden nach " & MaxAbsatzZahl & " Absätzen"
exit do
end if
end if ' PosErstzeichen <= 0
else
AbsatzCursor.collapsetoend()
' AbsatzCursor.GoRight(1,false)
AbsatzZaehler = AbsatzZaehler +1
if AbsatzZaehler > MaxAbsatzZahl then
msgbox "Ende nicht gefunden nach " & MaxAbsatzZahl & " Absätzen"
exit do
end if
end if ' Zeichen = "*"
' msgbox "AbsatzZaehler: " & AbsatzZaehler & " Kuerzel:" & Kuerzel & " Zeichen = " & Zeichen
IF KUERZEL = "STOPP" then
msgbox "Stoppmarke gefunden"
exit do
end if
Loop
msgbox "Fertig! " & eintragzaehler & " Einträge gefunden."
end sub
sub rausziehen(prueftext, PosErstzeichen as integer, kuerzel as string) as string
' ***************************************
' liefert das Kürzel das ein Leezeichen nach dem dritten Zeichen beginn
' PosErstzeichen = die Position, wo der Autotexteeingtrag begeinnt
' Dies ist der Text nach dem Tabulatuor
' PosErstzeichen = -1 , wenn Leerzeichen im Kürzel enthalten ist
' PosErstzeichen = -2 , wenn erster Tabulator fehlt
' PosErstzeichen = -3 , wenn zweiter Tabulator fehlt
' ***************************************
dim i as integer
dim zeichen as string
PosErstzeichen = 0
zeichen = mid(prueftext,2,1)
if asc(zeichen) <> 9 then
PosErstzeichen = -2
exit sub
end if
i = 2
do while i < len(prueftext)
i = i +1
zeichen = mid(prueftext,i,1)
'msgboy "prüftext: " & prueftext & "zeichen(" & i & ") = " & zeichen & " acs= " & asc(zeichen)
' if asc(zeichen) = 32 then
' PosErstzeichen = -1
' exit do
' end if
if asc(zeichen) = 9 then
PoserstZeichen = i + 1 ' Tabulator nicht mitzählen
exit do
end if
loop
if i >= len(prueftext) then PosErstzeichen = -3
kuerzel = mid(prueftext,3,PosErstzeichen-2-2)
if instr(kuerzel," ") <> 0 then PosErstzeichen = -1
end sub
sub test
end sub
[/code]