vba 强制替换宏如何也适用于标题
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11673195/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How Force replace macro apply on header also
提问by Moh Tarvirdi
I want to find & replace a text in word document. I created a macro as bellow.
我想在word文档中查找和替换文本。我创建了一个宏如下。
Sub Macro1()
ActiveDocument.Content.Find.Execute FindText:="#Text1", ReplaceWith:="acca", _
Replace:=wdReplaceAll
End Sub
It replaced all occurred but not in header/footer!! How forced to work on entire document include header/body/footer?
它取代了所有发生但不在页眉/页脚中的！！如何强制处理整个文档包括页眉/正文/页脚？
回答by L. Miller
I've always used this VBA code to Find/Replace, and it will do Headers/Footers along with the body of the document:
我一直使用这个 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
You can also copy and paste it a bunch of times in the same Sub to replace different strings at the same time.
您还可以在同一个 Sub 中多次复制和粘贴它以同时替换不同的字符串。
回答by Daniel
There should be a better way, but I cannot find it:
应该有更好的方法，但我找不到：
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
It appears that Word refuses to search an area unless it's your current view (which is ridiculous in my opinion). You cannot even search the entire document including headers & footers at once through the UI. Here's a questionat another site that seemed to get the same answer.
Word 似乎拒绝搜索某个区域，除非它是您当前的视图（在我看来这很荒谬）。您甚至无法通过 UI 一次搜索整个文档，包括页眉和页脚。这是另一个站点上的一个问题，似乎得到了相同的答案。
回答by JimmyPena
I don't see any way to "force" the Find and Replace dialog to include header and footer text. I recorded a macro while changing header text and got this code:
我没有看到任何“强制”查找和替换对话框包含页眉和页脚文本的方法。我在更改标题文本时录制了一个宏并得到了以下代码：
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
I went to View » Header/Footer, deleted a character and typed a new one.
我转到查看»页眉/页脚，删除一个字符并输入一个新字符。
What you probably have to do is Find & replace in VBA:
您可能需要做的是在 VBA 中查找和替换：
- Read the contents of the header into a String variable
- Parse the String variable, replacing text if necessary, then
- Write the contents of the String variable back to the header
- 将标头的内容读入 String 变量
- 解析 String 变量，必要时替换文本，然后
- 将 String 变量的内容写回标头
Repeat for the footer.
重复页脚。
回答by l0pan
I found the correct code hereIt will do text replacement even in textboxes in footer/header.
我在这里找到了正确的代码即使在页脚/页眉中的文本框中，它也会进行文本替换。
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
