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