Im Rahmen meiner Tätigkeit für den parlamentarischen Untersuchungsausschuss zur Untersuchung der politischen Verantwortung im Zusammenhang mit dem Kampfflugzeugsystem “Eurofighter Typhoon” von Anfang 2000 bis Ende 2017 stellte sich das Problem, Dokumentenbezeichnungen in Word-Dateien durch Hyperlinks, welche zu diesen Dokumenten in einer zentralen Datenbank verlinken sollten, zu ersetzen.
Eine erste Hürde bestand darin, dass diese Dokumentenbezeichnungen in allen Bereichen der Word-Dateien vorkommen konnten, daher die Dokumentenbezeichnungen konnten im normalen Fließtext verwendet werden und/oder in Fuß-/Endnoten als Zitat (dies war überwiegend der Fall).
Ein weiteres Problem bestand darin, die Dokumentenbezeichnungen automatisiert im Dokument ausfindig zu machen. Die Struktur der Bezeichnung war stets DokNr gefolgt von (idealerweise einem) Leerzeichen und einer fünfstelligen Zahl (z.B. DokNr 12345). Zu beachten war hierbei, dass die einzelnen Dokumentenbezeichnungen sich unterscheiden, aber auch öfters/wiederholt vorkommen konnten (z.B. wenn ein Dokument mehrfach zitiert wurde).
Den Makro-Code für Word habe ich in einem Beitrag veröffentlicht. Da ich persönlich mit LibreOffice arbeite, wollte ich jedoch das erstellte Word-Makro auch mit LibreOffice verwenden. Ich habe hierfür das Makro komplett neu geschrieben und an die API von LibreOffice angepasst. Nachfolgend findet sich der Code samt Hinweisen in den Kommentaren.
Sub SearchReplaceTextwithURL
' Ideen von https://forum.openoffice.org/en/forum/viewtopic.php?f=45&t=14896
' auch https://forum.openoffice.org/en/forum/viewtopic.php?f=7&t=67889
' Eine gute libreoffice Makro-Anleitung findet sich unter http://www.pitonyak.org/oo.php
' Dieser Prefix legt fest, ob vor der ID (bestehend aus 5 Ziffern) eine bestimmte Zeichenfolge stehen soll
searchprefix = "DokNr "
IDRegEx = "([0-9]+){5}"
searchprefixID = "@@@"
' Initalisiere die Suche mir RegEx Unterstützung
' Zu RegEx siehe https://help.libreoffice.org/latest/en-US/text/shared/01/02100001.html
' auch https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=19149
RDescrip = ThisComponent.createReplaceDescriptor
RDescrip.searchRegularExpression = True
' Suche nach Prefix und Leerzeichen gefolgt von 5 Ziffern, im gesamten Dokument inkl. Fußnoten, usw.
RDescrip.searchString = searchprefix + IDRegEx
' Suche wird gestartet
rngs = ThisComponent.findAll(RDescrip)
' Schleife durch alle Suchergebnisse
for i = 0 to rngs.count-1
foundText = rngs.getByIndex(i)
' Entferne Prefix und Leerzeichebn wieder aus Suchergebnis-String, damit ID mit 5 Ziffern übrig bleibt
' Funktion Replace wird benötigt (siehe unten)
' siehe https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Strings_(Runtime_Library)
DokNr = Replace(foundText.String, searchprefix, "")
Linktext = foundText.String
' markiere Prefixe mit searchprefixID, um diese im Anschluss aus dem Link ausschließen zu können
foundText.String = trim(searchprefix) + searchprefixID + DokNr
' Verwende die ID mit 5 Ziffern für die Dokumenten URL, entferne allfällige Leerzeichen vor und nach der ID mit trim()
foundText.hyperlinkURL = "https://datenbank.domain.at/search/results.php?pardoknr=" + trim(DokNr)
foundText.hyperlinkName = Linktext
next i
' Suche nach Prefix im gesamten Dokument inkl. Fußnoten, usw.
RDescrip.searchString = trim(searchprefix) + searchprefixID
' Suche wird gestartet
rngs = ThisComponent.findAll(RDescrip)
' Schleife durch alle Suchergebnisse
for i = 0 to rngs.count-1
foundText = rngs.getByIndex(i)
' Entferne Hyperlink von Prefix
foundText.hyperlinkURL = ""
foundText.hyperlinkName = ""
foundText.String = searchprefix
next i
End Sub
Function Replace(Source As String, Search As String, NewPart As String)
Dim Result As String
Dim StartPos As Long
Dim CurrentPos As Long
Result = ""
StartPos = 1
CurrentPos = 1
If Search = "" Then
Result = Source
Else
Do While CurrentPos <> 0
CurrentPos = InStr(StartPos, Source, Search)
If CurrentPos <> 0 Then
Result = Result + Mid(Source, StartPos, _
CurrentPos - StartPos)
Result = Result + NewPart
StartPos = CurrentPos + Len(Search)
Else
Result = Result + Mid(Source, StartPos, Len(Source))
End If ' Position <> 0
Loop
End If
Replace = Result
End Function
Visual Basic