Thema Datum  Von Nutzer Rating
Antwort
Rot Makro für Abbildungsverzeichnis
19.12.2023 11:46:06 Lina
NotSolved
19.12.2023 12:41:49 Gast46424
Solved

Ansicht des Beitrags:
Von:
Lina
Datum:
19.12.2023 11:46:06
Views:
198
Rating: Antwort:
  Ja
Thema:
Makro für Abbildungsverzeichnis
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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro für Abbildungsverzeichnis
19.12.2023 11:46:06 Lina
NotSolved
19.12.2023 12:41:49 Gast46424
Solved