Word hat die Nummerierung meiner Abbildungen leider komplett verhauen und ich habe daher einige Abbildungen selbst händisch nummeriert. Leider wird daraus aber ein komplett falsches Abbildungsverzeichnis erstellt. Ich habe versucht, ein Makro zu erstellen, das durch alle Abbildungen durchgeht, sich die Daten dazu speichert und am Ende ein Abbildungsverzeichnis erstellt, aber leider bleibt dieses leer. Wo liegt denn der Fehler im Code?
Sub
AbbVerzeichnis()
Dim
rng
As
Range
Dim
docText
As
String
Dim
match
As
Object
Dim
regexPattern
As
String
Dim
abbildungsverzeichnis
As
String
abbildungsverzeichnis =
"Abbildungsverzeichnis:"
& vbCrLf
docText = ActiveDocument.Range.text
regexPattern =
"Abb\. (\d+): ([^\r\n]+)"
Set
match = GetMatch(docText, regexPattern)
Do
While
Not
match
Is
Nothing
abbildungsverzeichnis = abbildungsverzeichnis &
"Abbildung "
& match.SubMatches(0) &
": "
& match.SubMatches(1) & vbCrLf
Set
match = GetMatch(docText, regexPattern, match.FirstIndex + Len(match.Value))
Loop
Set
rng = ActiveDocument.Range
rng.Collapse Direction:=wdCollapseEnd
rng.text = abbildungsverzeichnis
End
Sub
Function
GetMatch(text
As
String
, pattern
As
String
,
Optional
startPos
As
Long
= 1)
As
Object
Dim
regex
As
Object
Set
regex = CreateObject(
"VBScript.RegExp"
)
With
regex
.Global =
False
.MultiLine =
False
.IgnoreCase =
True
.pattern = pattern
End
With
If
regex.Test(Mid(text, startPos))
Then
Set
GetMatch = regex.Execute(Mid(text, startPos))(0)
End
If