OpenOffice.info

Code: Alles auswählen

Sub StarkePraxis
' Variablendeklaration:
'-----------------------
dim SuE_Argumente(18) as new com.sun.star.beans.PropertyValue 'Array für die Argumente der Suchen&Ersetzen-Funktion (Angabe vom Makrorekorder)
dim SP_Argumente(1) as new com.sun.star.beans.PropertyValue 'Array für die Argumente zur Dokumentspeicherung (Angabe vom Makrorekorder)
dim document   as object 'Variable für die Dokumentadressierung (wird durch UNO-Zugriff benötigt - Angabe vom Makrorekorder)
dim dispatcher as object 'UNO-Verbindung  (wird durch UNO-Zugriff benötigt - Angabe vom Makrorekorder)
dim WinDir as String 'Windows Systemverzeichnis
dim DateiNr as Integer 'Dateinummer für einen freien Dateikanal
dim Zeile as String 'Variable für die aktuell aus der Datei eingelesenen Zeile
dim Position as Integer 'Positionsangabe für die Suche nach Elementen zur Zeilenzerlegung
dim Werte(0,1) as String 'Array für die aus der Ini eingelesenen Werte (1. Element(0) = Name , 2. Element(1) = Wert)
dim W_Anzahl as Integer	'Zähler für die Werteanzahl, die eingelesen wurde
dim i as integer 'die berühmte Zählvariable i

'Jetzt werden die grundlegenden Definitionen vorgenommen:

'Dokumentzugriff für UNO realisieren:
'------------------------------------
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

'Der Makrorecorder meint, dies sind die richtigen Einstellungen für Suchen&Ersetzen:
'-----------------------------------------------------------------------------------
SuE_Argumente(0).Name = "SearchItem.StyleFamily"
SuE_Argumente(0).Value = 2
SuE_Argumente(1).Name = "SearchItem.CellType"
SuE_Argumente(1).Value = 0
SuE_Argumente(2).Name = "SearchItem.RowDirection"
SuE_Argumente(2).Value = true
SuE_Argumente(3).Name = "SearchItem.AllTables"
SuE_Argumente(3).Value = false
SuE_Argumente(4).Name = "SearchItem.Backward"
SuE_Argumente(4).Value = false
SuE_Argumente(5).Name = "SearchItem.Pattern"
SuE_Argumente(5).Value = false
SuE_Argumente(6).Name = "SearchItem.Content"
SuE_Argumente(6).Value = false
SuE_Argumente(7).Name = "SearchItem.AsianOptions"
SuE_Argumente(7).Value = false
SuE_Argumente(8).Name = "SearchItem.AlgorithmType"
SuE_Argumente(8).Value = 0
SuE_Argumente(9).Name = "SearchItem.SearchFlags"
SuE_Argumente(9).Value = 65536
SuE_Argumente(10).Name = "SearchItem.SearchString"
SuE_Argumente(10).Value = "Dieses Feld wird nacher durch den Suchtext ersetzt."
SuE_Argumente(11).Name = "SearchItem.ReplaceString"
SuE_Argumente(11).Value = "Dieses Feld wird nacher durch den Ersteztentext ersetzt."
SuE_Argumente(12).Name = "SearchItem.Locale"
SuE_Argumente(12).Value = 255
SuE_Argumente(13).Name = "SearchItem.ChangedChars"
SuE_Argumente(13).Value = 2
SuE_Argumente(14).Name = "SearchItem.DeletedChars"
SuE_Argumente(14).Value = 2
SuE_Argumente(15).Name = "SearchItem.InsertedChars"
SuE_Argumente(15).Value = 2
SuE_Argumente(16).Name = "SearchItem.TransliterateFlags"
SuE_Argumente(16).Value = 1280
SuE_Argumente(17).Name = "SearchItem.Command"
SuE_Argumente(17).Value = 3
SuE_Argumente(18).Name = "Quiet"
SuE_Argumente(18).Value = true


'Auch die Parameter für das Speichern kommen vom Makrorecorder:
'--------------------------------------------------------------
SP_Argumente(0).Name = "URL"
SP_Argumente(0).Value = "file:///" 'das wird nacher geändert
SP_Argumente(1).Name = "FilterName"
SP_Argumente(1).Value = "StarOffice XML (Writer)"

'So, jetzt kommt mal wieder etwas Eigenes
'----------------------------------------
WinDir = Environ ("WinDir") 'das Windows-Verzeichnis wird ermittelt
W_Anzahl = 0 'Die Anzahl der eingelesenen Werte ist momentan ja noch nicht groß

'Jetzt geht es los, ich versuche die Daten einzulesen und muss diese dazu erst einmal öffnen:
'--------------------------------------------------------------------------------------------
DateiNr = freefile 'freie Dateinummer ermitteln
'On Error GoTo Fehler 'Fehler führen hiermit zum Abbruch (zum Debuggen auskommentieren)
Open WinDir & "\SP.ini" for input as DateiNr 'INI öffnen

'Nun muss die relevante Sektion gefunden werden:
'-----------------------------------------------
do
Line Input #DateiNr, Zeile
Position = Instr (Zeile, "[Microsoft Word]")
loop until Position > 0

'Wenn ich nicht mit EOF abgeflogen bin, geht es hier weiter

'Nun werden die Werte und Wertenamen extrahiert und in das Datenarray übernommen
'-------------------------------------------------------------------------------
do 'dazu ist eine Schleife die beste Wahl der Waffen
Line Input #DateiNr, Zeile 'es wird die nächste Zeile eingelesen
Position = Instr (Zeile, "=") 'und die Position des Zeichens = ermittelt
if Position > 0 then 'dann wurde das Zeichen gefunden
	Werte (W_Anzahl,0) = mid(Zeile, 1, Position - 1) 'und es kann der Parametername in das Array übernommen werden
	Werte (W_Anzahl,1) = mid(Zeile, Position + 1, len(Zeile) 'dazu kommt jetzt noch der Parameterwert in´s Array
	if Werte (W_Anzahl,0) = "BDatei" then 'dann handelt es sich hier um den Dateinamen
		SP_Argumente(0).Value = "file:///" & ConvertBS(Werte (W_Anzahl,1)) 'der Dateiname wird schon mal zum Speichern übernommen
	end if
	W_Anzahl = W_Anzahl + 1 'Wertezähler hoch
	ReDim Preserve Werte(W_Anzahl,1) as String'Array vergrößern
else 'ansonsten könnte es sein, dass eine fehlerhafte Zeile vorgekommen ist, oder die nächste sektion beginnt
	Position = Instr (Zeile, "[") + Instr (Zeile, "]") 'daher prüfe ich mal, ob die beien markanten Zeichen für eine neue Sektion vorkommen
	if Position > 1 then exit Do 'dann beginnt eine neue Sektion und das Einlesen ist beendet
end if
loop until EOF(DateiNr) 'wenn keine neue Sektion kommt, dann geht es bis zum Dateiende weiter
Close #DateiNr 'die Datei brauche ich jetzt nicht mehr, ich habe alles im Array

'Und jetzt geht das Suchen und Ersetzen im Dokument los
'------------------------------------------------------
if W_Anzahl > 0 then 'ansonsten macht das ja alles keinen Sinn
	for i = 0 to W_Anzahl - 1
		SuE_Argumente(10).Value = "[" & Werte (i,0) & "]" 'Suchwert der Suchroutine bekannt geben
		SuE_Argumente(11).Value = Werte (i,1) 'Ersetzenwert der Suchroutine bekannt geben
		dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, SuE_Argumente())
	next i
end if

'Wenn man hier angekommen ist, dann brauch man doch nur noch zu speichern
'------------------------------------------------------------------------
if len(SP_Argumente(0).Value) > 10 then'ansonsten ist da wohl kein Dateiname angekommen
	dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, SP_Argumente())
end if

Exit Sub 'Hier ist Ende, das Fehlerhandling braucht ja nun nicht mehr durchlaufen werden

Fehler:
On Error resume next
Close #DateiNr 'Falls der Fehler erst nach dem Öffnen aufgetreten ist
MsgBox "Es ist ein Fehler bei der Datenübernahme aufgetreten!"
End Sub

private function ConvertBS (Wert as String) 'Ersetzt alle Backslash gegen normale Slash (für sensible Unixe)
dim pos as integer 'Der Wert um alle Positionen einmal anzusteuern,
for pos = 1 to len(Wert) 'was über die Schleife geschieht
	if mid(Wert,pos,1) = "\" then 'wenn Backslash gefunden, dann
		ConvertBS = ConvertBS & "/" 'ein normaler Slash rein
	else 'ansonsten
		ConvertBS = ConvertBS & mid(Wert,pos,1) 'wird das Zeichen so übernommen
	end if
next pos
end function