蒂姆·威廉姆斯和我都推荐乔纳森·韦斯特、彼得·休伊特、道格·罗宾斯和格雷格·马克西的MVP web page。

这是Word代码，因此您需要将其标记到WordDoc对象而不是ActiveDocument。

查找或替换任何地方的文本的完整代码有点复杂。因此，让我们一次一个步骤来更好地说明这个过程。在许多情况下，简单的代码足以完成工作。

步骤1

下面的代码循环遍历活动文档中的每个StoryRange，并将指定的.Text替换为.Replacement.Text：

Sub FindAndReplaceFirstStoryOfEachType()
  Dim rngStory As Range
  For Each rngStory In ActiveDocument.StoryRanges
    With rngStory.Find
      .Text = "find text"
      .Replacement.Text = "I'm found"
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
    End With
  Next rngStory
End Sub

(Note对于已经熟悉VBA的用户：而如果您使用Selection.Find，则必须指定所有的Find和Replace参数，例如.Forward = True，因为这些设置是从Find和Replace对话框的当前设置中获取的，这些设置是“粘滞的”，如果使用[Range].Find -如果您不在代码中指定参数值，则参数使用默认值，则不需要这样做）。
上面这个简单的宏有缺点，它只作用于11个StoryType中每一个的“第一个”StoryRange（即，第一个页眉、第一个文本框等）。虽然文档只有一个wdMainTextStory StoryRange，但它可以在某些其他StoryType中有多个StoryRange。例如，如果文档包含页眉和页脚未链接的节，或者文档包含多个文本框，这些StoryType将有多个StoryRanges，并且代码将不对第二个和后续StoryRanges起作用。2更复杂的是，如果文档包含未链接的页眉或页脚，并且其中一个页眉或页脚为空，则VBA可能难以“跳转”空页眉或页脚并处理后续页眉和页脚。

第二步

要确保代码作用于每个StoryType中的每个StoryRange，您需要：
x一个一个一个一个x一个一个二个x
还有一个问题。与查找和替换实用程序一样，上面的代码可能会丢失嵌套在不同StoryType/StoryRange中的一个StoryType/StoryRange中包含的任何文本。虽然wdMainTextStory StoryRange中的嵌套StoryType/StoryRange不会出现此问题，但页眉和页脚类型StoryRanges中会出现此问题。例如，位于页眉或页脚中的文本框。

步骤3

幸运的是，Jonathan West为这种嵌套StoryRanges的问题提供了一个解决方案。该解决方案利用了文本框和其他绘图形状包含在文档的ShapeRange集合中这一事实。因此，我们可以检查六个页眉和页脚StoryRanges中每个的ShapeRange是否存在形状。如果找到了形状，则检查每个形状是否存在文本，最后，如果Shape包含文本，则将搜索范围设置为该Shape的. TextFrame. TextRange。
最后一个宏包含了在文档中“任意位置”查找和替换文本的所有代码。添加了一些增强功能，使应用所需的查找和替换文本字符串变得更加容易。
注意：粘贴之前，请务必将代码文本转换为纯文本：如果直接从Web浏览器粘贴，空格将被编码为不间断空格，对于VBA而言，这些空格不是“空格”，将导致编译或运行时错误。另外：请注意此代码中的长行。当您将此代码粘贴到VBA编辑器中时，粘贴内容中的任何地方都不应出现可见的红色。如果出现，请小心地尝试将顶部的红色行与其下方的红色行连接起来（不要删除任何可见字符）。

Public Sub FindReplaceAnywhere()
  Dim rngStory As Word.Range
  Dim pFindTxt As String
  Dim pReplaceTxt As String
  Dim lngJunk As Long
  Dim oShp As Shape
  pFindTxt = InputBox("Enter the text that you want to find." _
    , "FIND" )
  If pFindTxt = "" Then
    MsgBox "Cancelled by User"
    Exit Sub
  End If
  TryAgain:
  pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )
  If pReplaceTxt = "" Then
    If MsgBox( "Do you just want to delete the found text?", _
     vbYesNoCancel) = vbNo Then
      GoTo TryAgain
    ElseIf vbCancel Then
      MsgBox "Cancelled by User."
      Exit Sub
    End If
  End If
  '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
      SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
      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 oShp.TextFrame.HasText Then
              SearchAndReplaceInStory oShp.TextFrame.TextRange, _
                  pFindTxt, pReplaceTxt
            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
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
    ByVal strSearch As String , ByVal strReplace As String )
  With rngStory.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strSearch
    .Replacement.Text = strReplace
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
End Sub