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()
'
' AbbVerzeichnis Makro
'
'
 
Dim rng As Range
Dim docText As String
Dim match As Object
Dim regexPattern As String
Dim abbildungsverzeichnis As String

' Initialisiere das Abbildungsverzeichnis
abbildungsverzeichnis = "Abbildungsverzeichnis:" & vbCrLf

' Text des gesamten Dokuments in eine Variable laden
docText = ActiveDocument.Range.text

' Definiere das reguläre Ausdrucksmuster
regexPattern = "Abb\. (\d+): ([^\r\n]+)"

' Suche nach Übereinstimmungen im Dokument
Set match = GetMatch(docText, regexPattern)

' Durchlaufe die gefundenen Übereinstimmungen und füge sie zum Abbildungsverzeichnis hinzu
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

' Füge das Abbildungsverzeichnis am Ende des Dokuments ein
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