Hallo Alle!

Meine Kenntnisse mit VBA in Word sind leider beschränkt. Ich sitze seit Längerem an einem Skript, welches mir repititive Arbeiten abnehmen soll. Auch die Hilfe von Suchfunktion im Forum und ChatGPT brachte leider keinen Erfolg. Vielleicht könnt ihr mir helfen.

Ich habe ein Word-Dokument, welches mehrere Abschnitte enthält, die wiederum Unter-Abschnitte enthalten. Die Abschnitte sind mittels Formatvorlagen in einander untergeordneten Listen mit mehreren Ebenen organisiert. Kurzes Beispiel:

A. [Formatvorlage "Überschrift 1"]

1. Text... [Formatvorlage "Überschrift 2"]

2. Text... [Formatvorlage "Überschrift 2"]

B. [Formatvorlage "Überschrift 1"]

1. Text... [Formatvorlage "Überschrift 2"]

    a) Untergeordnete aufzählung [Formatvorlage "Überschrift 3"]

    b) Untergeordnete aufzählung [Formatvorlage "Überschrift 3"]

2. Text... [Formatvorlage "Überschrift 2"]

C. [Formatvorlage "Überschrift 1"]

1. Text... [Formatvorlage "Überschrift 2"]

und so weiter....

Das Ziel ist, einen bestimmten Abschnitt, den ich eingebe, vollständig zu ersetzen, um auszugsweise Abschriften herzustellen. Beispielsweise soll der gesamte Abschnitt B. mitsamt dem gesamten nachfolgenden Text bis zum Abschnitt C. ersetzt werden durch "...pp...". Idealerweise soll die nachfolgende Ziffer C. dann auch C. bleiben, also nicht zur neuen Ziffer B. werden. Mein Skript sieht bisher so aus:

Sub ErsetzeAbschnitt()
    Dim userInput As String
    Dim doc As Document
    Dim range As range
    Dim startRange As range
    Dim endRange As range
    Dim foundSection As Boolean
    
    ' Benutzereingabe abfragen
    userInput = InputBox("Geben Sie den Abschnitt ein, der ersetzt werden soll:", "Abschnitt ersetzen")
    
    ' Dokument und Range initialisieren
    Set doc = ActiveDocument
    Set range = doc.Content
    foundSection = False
    
    ' Schleife über alle Absätze im Dokument
    For Each para In doc.Paragraphs
        ' Überprüfen, ob der Absatz eine spezielle Nummerierungsfunktion hat
        If para.range.ListFormat.ListType <> wdListNoNumbering Then
            ' Überprüfen, ob der Absatz mit dem eingegebenen Text beginnt
            If Left(para.range.ListFormat.ListString, Len(userInput)) = userInput Then
                ' Bereich des Abschnitts festlegen
                If Not foundSection Then
                    Set startRange = para.range
                    foundSection = True
                End If
            ElseIf foundSection Then
                ' Den nächsten Absatz mit gültiger Nummerierung finden
                Set endRange = para.range
                Exit For
            End If
        ElseIf foundSection Then
            ' Absatz durchsuchen, um untergeordnete Nummerierungen zu erfassen
            For Each subPara In para.range.Paragraphs
                If subPara.range.ListFormat.ListType <> wdListNoNumbering Then
                    Set endRange = subPara.range
                    Exit For
                End If
            Next subPara
            
            If endRange Is Nothing Then
                ' Kein weiterer Absatz mit gültiger Nummerierung gefunden
                Set endRange = para.range
                Exit For
            End If
        End If
    Next para
    
    ' Den gesamten Abschnitt ersetzen, wenn ein Abschnitt gefunden wurde
    If foundSection Then
        range.Start = startRange.Start
        range.End = endRange.Start
        range.Text = "...pp..."
    Else
        MsgBox "Der angegebene Abschnitt wurde nicht gefunden.", vbExclamation
    End If
End Sub

Gebe ich zum Beispiel "B." ein, findet das Skript auch den Abschnitt B., ersetzt aber auch nur diese Überschrift, nicht aber den nachfolgenden Text bis zum Beginn des Abschnitt C. Weiß jemand vielleicht Rat?

Jede Hilfe ist willkommen.

Herzlichen Dank!

Moritz