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_p...ld_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/show...Previous/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/...AllWithVBA.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/ 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)'.