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

单词宏用于查找和替换word文档中的所有文本框

3 个答案: