Replacing text in all sections, headers and footers

[stevetalaga]

I have some documents that I use as templates which have simple text tags (eg "<<First>>") throughout. I am using a User Form to get values to replace the text tags with whatever is entered into the user form. The problem I have is that only the text tags in the main body of the document are replaced. Any tags in the headers and footers are not replaced.

I found some code on Greg Maxeys site (http://gregmaxey.mvps.org/word_tip_pages/field_macros.html) which has been a great help in getting me to where I am now (Thank you very much Greg! Donation on the way) which I have adapted for this requirement but I still can't get the tags in my headers / footers to update. The code steps through the different StoryTypes within the document and executes the text replacement for each StoryType. Unfortunately, whilst the code does step through each StoryType (I added a MsgBox to show the StoryTypes value on each iteration) the text replacement code doesn't seem to be looking at the current StoryType as it just replaces the tags in the main body of the document.

Here's the code I have:

Public Sub EntireDocument()
Dim rngStory As Word.Range
Dim lngLink As Long
lngLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges 'Iterate through all linked stories
Do
On Error Resume Next


MsgBox rngStory.StoryType ' This just shows that the code is stepping through the different StoryTypes (headers, footers etc)

' ??? Do I need something here to set the focus onto rngStory???

' This is the code I want to execute in each section body header and footer
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<<First>>"
.Replacement.Text = varFirstName
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll


On Error GoTo 0


'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange

Loop Until rngStory Is Nothing
Next rngStory
lbl_Exit:
Exit Sub
End Sub


Any help is greatly appreciated.
Thanks
Steve

[macropod]

Although StoryRanges are useful for many things, Find/Replace isn't one of them.

You could use code like:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section
Dim HdFt As HeaderFooter
With ActiveDocument
For Each Rng In .StoryRanges
On Error Resume Next
With .Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.Text = "<<First>>"
.Replacement.Text = varFirstName
.MatchCase = True
.MatchAllWordForms = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
On Error GoTo 0
Next
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt
If .LinkToPrevious = False Then
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.Text = "<<First>>"
.Replacement.Text = varFirstName
.MatchCase = True
.MatchAllWordForms = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.Text = "<<First>>"
.Replacement.Text = varFirstName
.MatchCase = True
.MatchAllWordForms = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End If
End With
Next
Next
End With
End Sub

[stevetalaga]

Thank you very much!
A slight adjustment to line 8 and it worked at treat. Much appreciated.

[macropod]

You could use code like:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section
Dim HdFt As HeaderFooter
With ActiveDocument
For Each Rng In .StoryRanges
On Error Resume Next
With .Rng.Find
Minor correction. Change:
With .Rng.Find
to:
With Rng.Find

[gmaxey]

Paul,

Curious as to why you feel storyranges aren't suited for find and replace. I've been using this same basic process for years and I've never had a problem.


Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngValidate As Long
Dim oShp As Shape
pFindTxt = InputBox("Enter the text that you want to find.", _
"FIND")
If pFindTxt = "" Then
MsgBox "Cancelled by User"
Exit Sub
End If
Tryagain:
pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
If pReplaceTxt = "" Then
If MsgBox("Do you just want to delete the found text?", vbYesNoCancel) = vbNo Then
GoTo Tryagain
ElseIf vbCancel Then
MsgBox "Cancelled by User."
Exit Sub
End If
End If
'Fix the skipped blank Header/Footer problem
lngValidate = ActiveDocument.Sections(1).Headers(1).Range.StoryType
ResetFRParameters
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
SrcAndRplInStory 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
SrcAndRplInStory 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
Public Sub SrcAndRplInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub ResetFRParameters()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

[macropod]

Curious as to why you feel storyranges aren't suited for find and replace. I've been using this same basic process for years and I've never had a problem.
Because F/R code doesn't work reliably with every Section header & footer in a multi-section document. See the discussion here http://www.vbaexpress.com/forum/showthread.php?48775-LinkToPrevious/page2 for example.

[snb]

To adapt values in all kinds of places in a document by way of a userform you'd better make use of docvariables.

Otherwise:


Sub M_snb()
With Application.Dialogs(117)
.Display ' click on 'cancel' to close the dialog
sn = Array(.Find, .Replace)
End With

For Each sr In ThisDocument.StoryRanges
sr.Find.Execute sn(0), , , , , , , , , sn(1), 2
Next
End Sub

[macropod]

To adapt values in all kinds of places in a document by way of a userform you'd better make use of docvariables.
Not much use for replacing content that's already there.

PS: Your code doesn't work reliably in multi-section documents - see previous discussion...

[Paul_Hossler]

I adapted

http://word.mvps.org/faqs/macrosvba/FindReplaceAllWithVBA.htm


to a what I hope / wanted / intended to be a 'general purpose', 'global', 'any where in the document' S&R sub




Sub StrReplace(OldStr As String, NewStr As String, _
Optional WholeWord = False, _
Optional MatchCase = False, _
Optional WildCard = False)

Dim xStory As Range, xStory1 As Range

'There are 17 different types of stories that can be part of a document,
' wdMainTextStory
' wdTextFrameStory
' wdPrimaryFooterStory, wdFirstPageFooterStory , wdEvenPagesFooterStory
' wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory
' wdFootnotesStory, wdFootnoteContinuationNoticeStory, wdFootnoteContinuationSeparatorStory, wdFootnoteSeparatorStory
' wdCommentsStory
' wdEndnotesStory, wdEndnoteContinuationNoticeStory, wdEndnoteContinuationSeparatorStory, wdEndnoteSeparatorStory
For Each xStory In ActiveDocument.StoryRanges

'
Set xStory1 = xStory

With xStory1.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = OldStr
.Replacement.Text = NewStr
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = MatchCase
.MatchWholeWord = WholeWord
.MatchWildcards = WildCard
.MatchSoundsLike = False
.MatchAllWordForms = False

.Execute Replace:=wdReplaceAll

End With


'As mentioned previously, the above code will only act upon the first story for
'each story type in the document. (The first Header, the first Text Box, and
'so on). If your document contains sections with un-linked headers and
'footers in them, or, for example, contains more than one Text Box, the
'code will not act upon the second and subsequent occurrences of each type
'of story. So to make sure that the code does act on each occurrence of the
'text, no matter where it appears, you have to make use of the
'NextStoryRange method as in the following code:
Do While Not (xStory1.NextStoryRange Is Nothing)
Set xStory1 = xStory1.NextStoryRange
With xStory1.Find
.Text = OldStr
.Replacement.Text = NewStr
.Forward = True
.Wrap = wdFindContinue 'Continue
.Format = False
.MatchCase = MatchCase
.MatchWholeWord = WholeWord
.MatchWildcards = WildCard
.MatchSoundsLike = False
.MatchAllWordForms = False

.Execute Replace:=wdReplaceAll
End With
Loop

Next

End Sub




Not stress tested by millions of users, but seems to work.

There is a note, but the web site might be out of date, i.e. pre-2007



Unfortunately, even this method doesn't work reliably if you have any blank Headers or Footers in your document. If, for example, you have a document in which the first section has a blank primary Header in the first section (such as might be the case for a report cover sheet), then none of the primary Headers in the subsequent sections will be checked! Another thing that is well worth contacting http://support.microsoft.com/contactus/ (http://support.microsoft.com/contactus/?ws=support) about.

Paul

[macropod]

For a generalised routine, I'd be inclined to take a slightly different approach, along the lines of:

Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter, Fnd As String, Rep As String
Fnd = "Find Text": Rep = "Replace Text"
With ActiveDocument
For Each Rng In .StoryRanges
Select Case Rng.StoryType
Case wdPrimaryFooterStory, wdFirstPageFooterStory, wdEvenPagesFooterStory, _
wdPrimaryHeaderStory, wdFirstPageHeaderStory, wdEvenPagesHeaderStory
Case Else
Call RangeFndRep(Rng, Fnd, Rep)
End Select
Next
For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt
If .LinkToPrevious = False Then
Call RangeFndRep(Rng, Fnd, Rep)
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
Call RangeFndRep(Rng, Fnd, Rep)
End If
End With
Next
Next
End With
End Sub
'
Sub RngFndRep(Rng As Range, Fnd As String, Rep As String)
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.Text = Fnd
.Replacement.Text = Rep
.MatchCase = True
.MatchAllWordForms = False
.MatchWholeWord = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
End Sub
You could, of course, add more parameters to the RngFndRep arguments as you have done.

[Paul_Hossler]

hmmmmm --

if I'm reading this right, you

1. for each story range except the 6 H/F ones do a S&R

2. for each section for each header do the S&R if it's not linked to the previous

3. for each section for each footer do the S&R if it's not linked to the previous


Could you put on your teaching hat and explain the differences and the advantages?
Yours has the advantage of being a little clearer to follow I can see that, but in the 2 marked lines, wouldn't Rng be out of scope?
Did you intend HdFt?



For Each Sctn In .Sections
For Each HdFt In Sctn.Headers
With HdFt
If .LinkToPrevious = False Then
Call RangeFndRep(Rng, Fnd, Rep) '-----------------------------------
End If
End With
Next
For Each HdFt In Sctn.Footers
With HdFt
If .LinkToPrevious = False Then
Call RangeFndRep(Rng, Fnd, Rep) '--------------------------------------
End If
End With
Next
Next


Paul

[macropod]

The attitude I took was that, since you can't rely on storyranges for F/R, one might as well not include them in the storyrange processing and, instead, handle them at the section level. And, if a header or footer is linked to a previous one, there's no point in processing it, as the one its linked to is the only one that needs processing. As for "Did you intend HdFt?" the 'Call RangeFndRep(Rng, Fnd, Rep)' code should be 'Call RangeFndRep(HdFt.Range, Fnd, Rep)'.