Revised Find and Replace Code

[Greg Maxey]

Earlier today an OP indicated that the Find and Replace Anywhere macro frequently cited on these pages failed to find text in a TextBox that is nested in a header or footer. Much to my surprise, I noticed today that the regular find and replace utility won't find that text either.

Jonathan West provided an idea for using the shape.textframe.textrange as workaround. I experimented with Jonathan's idea today and found that it could be incorporated into the general Find and Replace Anywhere macro. After some initial testing I found that the find and replace was occurring twice in the maintext story. I have since adapted the code and haven't been able to break it. It appears to solve the nested Textbox issue and is submitted below for review and comment.

Public Sub FindReplaceAnywhere()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk 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
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

Public 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