字宏來查找和替換文本框中的所有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