Rook,

Seems to work fine here:
Results.jpg

But if you want skip the TextFrame story, see below and unstet the appropriate line:

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
        'If rngStory.StoryType = 5 Then Exit 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
        While .Execute
          rngStory.HighlightColorIndex = wdGreen
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
      Case 2
        .Font.Italic = True
        While .Execute
          rngStory.HighlightColorIndex = wdRed
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
      Case 3
        .Font.Underline = wdUnderlineSingle
        While .Execute
          rngStory.HighlightColorIndex = wdYellow
          rngStory.Collapse wdCollapseEnd
          DoEvents
        Wend
    End Select
  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