Microsoft Office Forums - View Single Post

gmayor · 01-28-2022, 10:32 PM

Documents are created from an assortment of story ranges of which the ActiveDocument range is only one. Greg's macro addresses only that document range. The following will also address text boxes in that range. It will not however address text boxes within another range, such as the header range. If that is an issue, you will need a belt and braces approach to look through all the story ranges in the document.

Code:

Sub PrintSpecificWordsII()
Dim myWords()
Dim lngIndex As Long
Dim oStory As Range
    myWords = Array("Word1", "Word2", "Word3", "Word4", "Word5")
    For lngIndex = 0 To UBound(myWords)
        For Each oStory In ActiveDocument.StoryRanges
            With oStory.Find
                .ClearFormatting
                .Text = myWords(lngIndex)
                .Forward = True
                While .Execute
                    oStory.HighlightColorIndex = wdBrightGreen
                    Application.PrintOut Range:=wdPrintCurrentPage
                    oStory.Collapse wdCollapseEnd
                Wend
            End With
            If oStory.StoryType <> wdMainTextStory Then
                While Not (oStory.NextStoryRange Is Nothing)
                    Set oStory = oStory.NextStoryRange
                    With oStory.Find
                        .ClearFormatting
                        .Text = myWords(lngIndex)
                        .Forward = True
                        While .Execute
                            oStory.HighlightColorIndex = wdBrightGreen
                            Application.PrintOut Range:=wdPrintCurrentPage
                            oStory.Collapse wdCollapseEnd
                        Wend
                    End With
                Wend
            End If
        Next oStory
    Next lngIndex
lbl_Exit:
    Set oStory = Nothing
    Exit Sub
End Sub