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.
Unable to Expand images
Myself and colleagues are encountering an issue when trying to expand an image (using Microsoft Teams Version 1.3.00.8663 (64 bit) app on a pc). Clicking on the image results in the background darkening and a small broken icon appearing. It seems to mostly apply to images that have been pasted. The issue eventually clears itself after a week or so but then returns. Is this a known issue? Is there any way to resolve this?
