如何强制更换宏观上头也适用(How Force replace macro apply on hea

我想查找和替换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

您也可以复制和粘贴一堆次在同一子在同一时间更换不同的字符串。

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

看来，话语拒绝，除非它是当前视图（这是荒谬的，我认为）来搜索的区域。 你甚至不能搜索整个文档，包括页眉和页脚一次通过用户界面。 这里有一个问题，那似乎得到了同样的答案另一个站点。

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取代：

• 读出的标头的内容为一个字符串变量
• 解析字符串变量，如果有必要替换文本，然后
• 写入字符串变量的内容回头

重复页脚。

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

文章来源: How Force replace macro apply on header also