Forum Discussion

Kendethar's avatar
Kendethar
Iron Contributor
Dec 07, 2022

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 checked saying to do so).

The only thing I found on the internet was the Range.Expand and Range.Collapse functions which did not work at all, no matter how much I played with it. I did manage to get the result I wanted using the SendKeys function with a collab of .Activate but it was really wonky. However, when I was playing around with it and searching through the arguments, I found .CollapsedState which could only follow after .Paragraphs(). I tested it and it worked!

 

Polished 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
    'ThisDocument.ActiveWindow.NewWindow.Activate 'OUTDATED METHOD
    'ActiveWindow.Close 'OUTDATED METHOD
    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
                'ThisDocument.Paragraphs(ParaIndex).Range.Select 'OUTDATED METHOD
                'SendKeys "{RIGHT}", True 'OUTDATED METHOD
                'SendKeys "~", True 'OUTDATED METHOD
                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

 

 

It would be cool to use a date function for criteria at some point too, to expand headers that are within today's date.

 

Notes:

• The commented-out code followed by 'OUTDATED METHOD was the first working but wonky attempt. Lines can be removed. 

• The "check_box" variable is for the only checkbox I have in the document, which is a form control (not an ActiveX control).

• You can change the "Heading 1" (ByVal as String for the FindParagraph function) under the "ExpandNotes" sub to the style name that is applicable to your headers. 

• You can change the "*Notes*" to whatever text your header is. You can also expand/collapse multiple headers if you include an Or statement(s) in that If.

• The code is under the "ThisDocument" (Microsoft Word Objects) module for my workbook (not for "Normal"). 

• Edit/add/remove from the code to your needs.

 

  • 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
  • Kendethar's avatar
    Kendethar
    Iron Contributor

    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

Resources