Word 宏用文本框查找和替换 word 文档中的所有内容

Question

我需要编写一个 VBA Word 宏来进行查找和替换，以将一种字体中出现的所有文本更改为另一种字体。我拥有的代码（如下所列）执行此操作，但忽略了文档中文本框中的所有文本。如何修改此宏以搜索文档中文本框内外的所有文本（页眉和页脚将是一个加号，但不是绝对必要的），或者在宏中以不同的方式进行。此宏是处理数以万计文档的更大宏的一部分，因此手动执行任何操作都不是一种选择。

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Font.Name = "PPalotina2007"
    .Replacement.Font.Name = "Palotina X"
End With
Selection.Find.Execute Replace:=wdReplaceAll

Answer 1

在http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm 找到这个我应该注意这仅适用于每种故事类型的第一个...在提供的链接上提供了更好的代码，用于访问所有故事范围。

Sub FindAndReplaceFirstStoryOfEachType()
  Dim rngStory As Range
  For Each rngStory In ActiveDocument.StoryRanges
    With rngStory.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Font.Name = "PPalotina2007"
        .Replacement.Font.Name = "Palotina X"
    End With
    rngStory.Find.Execute Replace:=wdReplaceAll
  Next rngStory
End Sub 

Answer 2

感谢 Chrismas007 将 http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm 链接到基于该链接的“完整答案”，我将在下面为需要此链接的其他人发布该链接。它不仅搜索文本字符串，还搜索它更改的特定字体。

Sub FindReplaceAnywhere( _
                    ByVal pOldFontName As String, _
                    ByVal pNewFontName As String, _
                    ByVal pFindTxt As String, _
                    ByVal pReplaceTxt As String)
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
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
  Do
  SearchAndReplaceInStory rngStory, pOldFontName, pNewFontName, 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, pOldFontName, pNewFontName, 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

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

Answer 3

感谢 Harry Spier，尽管我不得不稍微修改您的代码 - 最后它工作得很好！

Sub FindReplaceAnywhere()

Dim pOldFontName As String
Dim pNewFontName As String
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape

pOldFontName = "FontDoe"  'replace with the font you want to replace
pNewFontName = "Font Dolores"  'replace with the font you really need to have in your doc

'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, pOldFontName, pNewFontName, 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, pOldFontName, pNewFontName, 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

---

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