I have a Word document with figures, and for some reason, Word is completely messing up the figure numbers, so I basically re-numbered them on my own. However, when I create the Table of Figures, the numbers and pages don't match at all.
I tried writing my own macro to go through the doc, scan for image captions and add a Table of Figures, but it doesn't really seem to work. Any suggestions on the code?
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