Here is some sample code that you can probably adapt to suit your needs:
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
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 = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub
--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.
I wrote a macro that searches for (German) abbreviations such as
"d.h.", "z.B." etc. and inserts nonbreaking spaces formatted with font
size 4. It is working fine.
But how can I get it to search and replace not only in the main
document story but in the headers, footers and footnotes as well?
Sub InsertNonbreakingSpaces()
With ActiveDocument.Range.Find
.Text = "(<[a-zA-Z]>).(<[a-zA-Z]>)"
.MatchWildcards = True
.Execute Replace:=wdReplaceAll, ReplaceWith:="\1.####\2"
End With
With ActiveDocument.Range.Find
.Text = "####"
With .Replacement
.Text = "^s"
.Font.Size = 4
End With
.Execute Replace:=wdReplaceAll
End With
End Sub
