Word Macro to find and replace all in word document with textboxes

问题

I need to write a VBA Word macro that will do a find and replace to change all occurrences of text in one font to another font. The code I have (listed below) does this but in ignores all the text in text boxes in the document. How do I either modify this macro to search all text both inside and outside textboxes in the document (headers and footers would be a plus but not absolutely necessary) or do it a different way in a macro. This macro is part of a larger macro that processes tens of thousands of documents so doing anything manually isn't an option.

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

回答1:

Found this at http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm I should note this only works on the FIRST of each type of Story... There are better code on the link provided for getting to all story ranges.

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

回答2:

Thank you Chrismas007 for the link http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm to the "complete answer" based on that link which I'm posting below for anyone else who needs this. It does a search not only on a text string but also on a particular font which it changes.

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

回答3:

Thanks Harry Spier, even though I had to modify your code a little - finally it works great!

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

来源：https://stackoverflow.com/questions/27259393/word-macro-to-find-and-replace-all-in-word-document-with-textboxes

标签

vba

word-vba