Word VBA - Überschriften bzw. Kapitel mit Steuerelement Kontrollbox hinzufügen und entfernen

Hallo zusammen,

nach einigen Stunden des Probierens und Googlens wende ich mich nun an euch in der Hoffnung das jemand eine Idee hat.

Ich habe ein Dokument das derzeit 10 Überschriften bzw. Kapitel hat die man in der Navigationsansicht auffinden kann.

Nun habe ich oben im Dokument eine Liste an Checkboxen (Steuerelemente).

Das SOLL so aussehen, das das Dokument bis auf der ersten Seite mit den Checkboxen leer ist. Setzt man nun eine Checkbox auf True, dann wird das entsprechende Kapitel am Ende des Dokuments eingefügt. Nehme ich das Häkchen wieder raus, dann soll das Dokument gelöscht werden.

Dabei werden die Texte als Autoteste gespeichert und in einer dotx hinterlegt, bzw. das Dokument in dem ich arbeite ist ein dotx.

Mit Mühe und Brechen habe ich dieses Stückchen Skript hinbekommen, sodass er mir am Ende des Dokuments schon mal was einfügt:

Private Sub Document_ContentControlOnExit(ByVal kk As ContentControl, Cancel As Boolean)

With ActiveDocument
    If kk.Tag = "Test" Then  
        If kk.Checked = True Then
            Selection.EndKey Unit:=wdStory
            Selection.InsertBreak Type:=wdPageBreak
            Selection.TypeText "Antrag auf ..."  
            Selection.Range.InsertAutoText
        
         Else
             
            Dim strBookmark As String
            strBookmark = "Antrag auf ..."  
            
            MsgBox Bookmarks.Count
            If Bookmarks.Exists(Name:=strBookmark) Then
                Bookmarks(Index:=strBookmark).Delete
            End If
            
            ' Bookmarks("\HeadingLevel").Delete "Antrag auf "  
        End If
    End If
End With
End Sub

Der Else-Strang funktioniert nicht, da er den bookmark nicht findet. Ich bin mir aber auch nicht sicher ob das die richtige Herangehensweise ist :s

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 561082

Url: https://administrator.de/forum/word-vba-ueberschriften-bzw-kapitel-mit-steuerelement-kontrollbox-hinzufuegen-und-entfernen-561082.html

Ausgedruckt am: 18.05.2025 um 06:05 Uhr

8 Kommentare

Neuester Kommentar

Hi,
ich denke, im "True"-Block musst Du das Bookmark erst definieren, damit Du es später finden kannst.

Private Sub Document_ContentControlOnExit(ByVal kk As ContentControl, Cancel As Boolean)

With ActiveDocument
    If kk.Tag = "Test" Then  
        If kk.Checked = True Then
            Selection.EndKey Unit:=wdStory
            Selection.InsertBreak Type:=wdPageBreak
            Selection.TypeText "Antrag auf ..."  
            Selection.Range.InsertAutoText
            ActiveDocument.Bookmarks.Add Name:="Antrag auf ...", Range:=Selection.Range  
        
         Else
             
            Dim strBookmark As String
            strBookmark = "Antrag auf ..."  
            
            MsgBox Bookmarks.Count
            If Bookmarks.Exists(Name:=strBookmark) Then
                Bookmarks(Index:=strBookmark).Delete
            End If
            
            ' Bookmarks("\HeadingLevel").Delete "Antrag auf "  
        End If
    End If
End With
End Sub

Hm, dann ist Bookmark vielleicht falsch, da ich ja mit InsertAutoText einen Text hinzufüge der eine Überschrift im Format Überschrift1 hat und dadurch ist dieser dann in der Navigationsansicht verfügbar. D.h. ich kann den Textblock auch darüber per Maus löschen. Aber Ideal wäre es, wenn das alles über die Checkbox geht.

Hast Du das mit der von mir hinzugefügten Zeile 11 versucht?

Er gibt mir dann immer die Meldung "Ungültiger Textmarkenname", erstellt den Text aber durch das deaktivieren der checkbox passiert nichts, außer das die messagebox hoch kommt und den Wert 1 ausgibt.

EDIT: OK jetzt funktioniert es zumindest ohne Fehlermeldung, Bookmarks.Add kann nichts mit Leerzeichen, allerdings löscht er mit dem deaktivieren der Checkbox immernoch nicht den Textblock

@emeriks dein Vorschlag schein soweit zu funktionieren. Jetzt muss ich nur noch die

Bookmarks("\HeadingLevel").Delete

zum laufen bekommen. Leider gibt es online kaum referencen wie dies zu benutzen ist. Aber die Beschreibung zu HeadingLine passt auf jeden Fall schon mal:

\HeadingLevel: Die Überschrift, welche die Einfügemarke oder die Markierung mit untergeordneten Überschriften und Text enthält. Handelt es sich bei der aktuellen Markierung um Textkörper, schließt die Textmarke "\HeadingLevel" die vorhergehende Überschrift mit allen Überschriften und allem Text ein, die der Überschrift untergeordnet sind.

OK ich denke ich bin der Lösung nahe, aber noch will er nicht den Bookmark finden:

Private Sub Document_ContentControlOnExit(ByVal kk As ContentControl, Cancel As Boolean)

With ActiveDocument
    If kk.Tag = "Test" Then  
        If kk.Checked = True Then
            Selection.EndKey Unit:=wdStory
            Selection.InsertBreak Type:=wdPageBreak
            Selection.TypeText "Antrag auf "  
            Selection.Range.InsertAutoText
            Bookmarks.Add Name:="AntragAuf", Range:=Selection.Range  
        Else
            Dim strBookmark As String
            strBookmark = "AntragAuf"  
            
            If Bookmarks.Exists(Name:=strBookmark) Then
                Bookmarks(strBookmark).Select
                Selection.Bookmarks("\HeadingLevel").Delete  
            End If
        End If
    End If
End With
End Sub

In dem Else, bei Bookmarks(strBookmark).Select führt er es ordentlich aus, aber dann bei der letzten Anweisung gibt er mir einen Laufzeitfehler: 5941
Das angeforderte Element ist nicht in der Sammlung vorhanden.

Warum findet er die Selection nun nicht? :S

Warum in Zeile 17 nicht einfach ...?

Selection.Delete

@emeriks

weil er dann nicht den ganzen Blocktext löscht. Mit folgendem Skript habe ich es nun hinbekommen, das er einen Autotext per Checkbox hinzufügt und komplett wieder raus löscht + extra Seitenumbruch:

Private Sub Document_ContentControlOnExit(ByVal kk As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim strBookmark As String
strBookmark = "AntragAuf"  

With ActiveDocument
    If kk.Tag = "Test" Then  
        If kk.Checked = True Then
            Selection.EndKey Unit:=wdStory
            Selection.InsertBreak Type:=wdPageBreak
            Selection.TypeText "Antrag auf "  
            Selection.Range.InsertAutoText
            Bookmarks.Add Name:=strBookmark, Range:=Selection.Range
        Else
            If Bookmarks.Exists(Name:=strBookmark) Then
                Bookmarks(strBookmark).Select
                Bookmarks("\HeadingLevel").Select  
                Selection.Delete
                Selection.TypeBackspace
                Selection.TypeBackspace
            End If
        End If
    End If
End With
Application.ScreenUpdating = True
End Sub