Word Macro: Create Table of Figures by hand from manually numbered figures

44 Views Asked by At

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?

    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
End Function
0

There are 0 best solutions below