SOLVED - Expand/Collapse specified heading(s) based on criteria (VBA code)

Hello all, I spent an entire evening trying to figure out the VBA code to collapse all headings in my document upon opening except for my "Notes" header (and only if I had a form control checkbox...

2013

2016

Collapse

Collapse single header

Dec 07, 2022

Condensed code:

Private Sub Document_Open()
On Error GoTo ErrHandler
    ThisDocument.ActiveWindow.View.CollapseAllHeadings
    Dim check_box As ContentControl
    Set check_box = ThisDocument.Range.ContentControls(Index:=1)
    If check_box.Checked = True Then Call ExpandNotes
ErrHandler:
End Sub

Sub ExpandNotes()
On Error GoTo ErrHandler1
    Dim IsFound As Boolean
    IsFound = FindParagraph(ThisDocument.StoryRanges(wdMainTextStory), "Heading 1")
ErrHandler1:
End Sub

Public Function FindParagraph(ByVal SearchRange As Word.Range, ByVal ParaStyle As String) As Long
On Error GoTo ErrHandler2
    Dim ParaIndex As Long
    For ParaIndex = 1 To SearchRange.Paragraphs.Count
        If ThisDocument.Paragraphs(ParaIndex).Range.Style = ParaStyle Then
            FindParagraph = ParaIndex
            If ThisDocument.Paragraphs(ParaIndex).Range.Text Like "*Notes*" Then
                ThisDocument.Activate
                ThisDocument.Paragraphs(ParaIndex).CollapsedState = False
                Exit Function
             End If
        End If
    Next
ErrHandler2:
'Function built off of the original code (by freeflow): https://stackoverflow.com/questions/61209283/vba-word-find-a-paragraph-that-has-a-specific-style
End Function

Private Sub Document_Open() On Error GoTo ErrHandler ThisDocument.ActiveWindow.View.CollapseAllHeadings Dim check_box As ContentControl Set check_box = ThisDocument.Range.ContentControls(Index:=1) If check_box.Checked = True Then Call ExpandNotes ErrHandler: End Sub Sub ExpandNotes() On Error GoTo ErrHandler1 Dim IsFound As Boolean IsFound = FindParagraph(ThisDocument.StoryRanges(wdMainTextStory), "Heading 1") ErrHandler1: End Sub Public Function FindParagraph(ByVal SearchRange As Word.Range, ByVal ParaStyle As String) As Long On Error GoTo ErrHandler2 Dim ParaIndex As Long For ParaIndex = 1 To SearchRange.Paragraphs.Count If ThisDocument.Paragraphs(ParaIndex).Range.Style = ParaStyle Then FindParagraph = ParaIndex If ThisDocument.Paragraphs(ParaIndex).Range.Text Like "*Notes*" Then ThisDocument.Activate ThisDocument.Paragraphs(ParaIndex).CollapsedState = False Exit Function End If End If Next ErrHandler2: 'Function built off of the original code (by freeflow): https://stackoverflow.com/questions/61209283/vba-word-find-a-paragraph-that-has-a-specific-style End Function

Forum Discussion

SOLVED - Expand/Collapse specified heading(s) based on criteria (VBA code)

Resources