Loop to Collapse Paragraphs within Range Not Working

poetofpiano · #1 03-03-2018, 11:13 PM

I have a document using the built-in headings styles of Heading1, Heading2, and Heading3 in several places, and within each of these headings are paragraphs that have an outline level so that I can collapse the paragraphs. I have marked each of these paragraphs by the text "(1)" without the quotation marks so that I can find them with VBA.

What I am trying to do is loop through all the paragraphs under a single Heading (be it Heading1, 2, or 3) and collapse the paragraphs under that heading so that I can see the content within the heading much easier. This is what I have so far:

Code:

Sub CollapseOutlinesWithinHeading()
'Go to beginning of currently selected heading 
Dim heading As Range
Set heading = Selection.GoTo(What:=wdGoToHeading, Which:=wdGoToPrevious)

'select the entire heading
    Dim headingLevel As Range
    ' headingLevel encompasses the region under the preceding heading
    Set headingLevel = Selection.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")

'loop through to collapse paragraphs marked by text "(1)"
Set oRng = Selection.Range
  With oRng.Find
    While .Execute(FindText:="(1)", Forward:=True)
      If .Found = True Then
        oRng.Paragraphs(1).CollapsedState = True
      End If
    Wend
  End With
End Sub

This works fine if the selected heading is the last heading in the document. My problem is when I am acting on a heading in the middle of the document. Even though the routine defines the .find range to be the selected heading, the routine disregards this and continues on searching to the end of the document, collapsing every paragraph marked with "(1)" from the start of the selected heading to the end of the document.

I have read at https://gregmaxey.com/word_tip_pages..._property.html that the .find property is very finicky, but none of the reasons it is finicky seem like they should be triggered in my routine. Can anyone help me make my version of the routine work, or must I resort to what the user at https://superuser.com/questions/8853...-defined-range did, which is to only loop the number of times that the match is found in the selection? If so, how would that best be written in this case?

Thank you so much for your help!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Loop through all shapes in all stories not working	Peterson	Word VBA	5	03-04-2018 11:02 AM
Loop through worksheet range to show / hide shapes.	wlcdo2	Excel Programming	2	02-22-2017 05:10 PM
Range.Collapse?	tinfanide	Word VBA	5	01-17-2013 06:02 PM
Loop through folder of workbooks and copy range to other workbook	Snvlsfoal	Excel Programming	3	07-29-2011 05:55 AM
While loop not working right	Cbrehm	Excel Programming	0	05-11-2011 11:05 AM