Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For lngJunk = 1 To 3
ResetFRParams Selection.Range
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory rngStory, lngJunk
On Error Resume Next
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If Not oShp.TextFrame.TextRange Is Nothing Then
SrcAndRplInStory oShp.TextFrame.TextRange, lngJunk
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
Next lngJunk
End Sub
Public Sub SrcAndRplInStory(ByVal rngStory As Word.Range, lngRouter As Long)
With rngStory.Find
Select Case lngRouter
Case 1: .Font.Bold = True
Case 2: .Font.Italic = True
Case 3: .Font.Underline = wdUnderlineSingle
End Select
While .Execute
rngStory.HighlightColorIndex = wdGreen
DoEvents
Wend
End With
End Sub
Sub ResetFRParams(oRng As Range)
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub