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.
Accepted Solutions