How Force replace macro apply on header also
Question
I want to find & replace a text in word document. I created a macro as bellow.
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?
Solution
I've always used this VBA code to Find/Replace, and it will do Headers/Footers along with the body of the document:
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.
OTHER TIPS
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 question at another site that seemed to get the same answer.
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:
- 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
Repeat for the footer.
I found the correct code here It 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