vba - 强制替换宏如何也适用于标题

Question

我想查找和替换 word 文档中的文本。我创建了一个宏，如下所示。

Sub Macro1()
  ActiveDocument.Content.Find.Execute FindText:="#Text1", ReplaceWith:="acca", _
     Replace:=wdReplaceAll   
End Sub

它取代了所有发生但不在页眉/页脚中！如何被迫处理整个文档，包括页眉/正文/页脚？

Answer 1

我一直使用这个 VBA 代码来查找/替换，它会与文档正文一起执行页眉/页脚：

    Dim myStoryRange As Range


        For Each myStoryRange In ActiveDocument.StoryRanges
        With myStoryRange.Find
            .Text = "Text to find to replace goes here"
            .Replacement.Text = "And the replacement text goes here"
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
        Do While Not (myStoryRange.NextStoryRange Is Nothing)
            Set myStoryRange = myStoryRange.NextStoryRange
            With myStoryRange.Find
                .Text = "Text to find to replace goes here"
                .Replacement.Text = "And the replacement text goes here"
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
        Loop
    Next myStoryRange

也可以在同一个Sub中多次复制粘贴，同时替换不同的字符串。

Answer 2

应该有更好的方法，但我找不到：

Sub ReplaceHeaderFooterandBody(findString As String, replaceString As String)
ActiveDocument.Windows(1).View.SeekView = wdSeekPrimaryHeader
With Selection.Find
        .Text = findString
        .Replacement.Text = replaceString
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Windows(1).View.SeekView = wdSeekPrimaryFooter
With Selection.Find
        .Text = findString
        .Replacement.Text = replaceString
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Windows(1).View.SeekView = wdSeekMainDocument
With Selection.Find
        .Text = findString
        .Replacement.Text = replaceString
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

似乎 Word 拒绝搜索某个区域，除非它是您当前的视图（我认为这很荒谬）。您甚至无法通过 UI 一次搜索整个文档，包括页眉和页脚。这是另一个站点上的一个问题，似乎得到了相同的答案。

Answer 3

我看不到任何“强制”“查找和替换”对话框包含页眉和页脚文本的方法。我在更改标题文本时录制了一个宏并得到了以下代码：

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 7/26/2012 by Jimmy Peña
'
  If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
    ActiveWindow.Panes(2).Close
  End If
  If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
    ActivePane.View.Type = wdOutlineView Then
    ActiveWindow.ActivePane.View.Type = wdPrintView
  End If
  ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
  Selection.MoveRight Unit:=wdCharacter, Count:=1
  Selection.Delete Unit:=wdCharacter, Count:=1
  Selection.TypeText Text:="d"
End Sub

我去了查看»页眉/页脚，删除了一个字符并输入了一个新字符。

您可能需要做的是在 VBA 中查找和替换：

• 将标头的内容读入 String 变量
• 解析字符串变量，必要时替换文本，然后
• 将 String 变量的内容写回头部

重复页脚。

Answer 4

我在这里找到了正确的代码它甚至会在页脚/页眉的文本框中进行文本替换。

 Sub FindReplaceAnywhere(ByVal pFindTxt As String, ByVal pReplaceTxt As String)
  Dim rngStory As Word.Range
  Dim lngJunk As Long
  Dim oShp As Shape
TryAgain:
  '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
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