Public Sub RelaceAllGraphicsWithNothing()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim lngIndex As Long
  'Fix the skipped blank Header/Footer problem
  lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  'Iterate through all story types in the current document
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      SrcAndRplInStory rngStory, "^g^p", ""
      SrcAndRplInStory rngStory, "^g^l", ""
      SrcAndRplInStory rngStory, "^g", ""
      For lngIndex = rngStory.ShapeRange.Count To 1 Step -1
        rngStory.ShapeRange.Item(lngIndex).Delete
      Next lngIndex
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
lbl_Exit:
  Exit Sub
End Sub
Public Sub SrcAndRplInStory(ByVal rngStory As Word.Range, _
                                  ByVal strSearch As String, _
                                  ByVal strReplace As String)
  With rngStory.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strSearch
    .Replacement.Text = strReplace
    .Execute Replace:=wdReplaceAll
  End With
lbl_Exit:
  Exit Sub
End Sub