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.
