From: Greg Maxey on
After considerable wailing and gnashing of teeth, I have cobbled together
the code below that "appears" to replicate the built-in Replace All (for All
and Down direction) functionality in the current storyrange..

I used the worse case of replacing all found instances with the same search
text. The only suitable approach that I could find was to define a front
and back range (range before and after the cursor) process the back range
and then, if a continued search is required, process the front range. It is
working, but seems terribly clunky. Does anyone know of a different
approach for doing this? Thanks.

Option Explicit
Dim oRng As Word.Range
Dim oRngFront As Word.Range
Dim oRngCheck As Word.Range
Dim strReplace As String
Dim lngCase As Long
Dim lngCount As Long
Sub VBAReplaceAll()
Dim strWrap As String
Set oRng = ActiveDocument.Range
Set oRngFront = ActiveDocument.Range
oRng.Start = Selection.Range.Start
oRngFront.End = oRng.Start - 1
Set oRngCheck = oRngFront.Duplicate
strWrap = "Ask" 'Set to "Ask" or "Continue"
lngCount = 0
strReplace = "^&"
Call BackPiece(oRng)
Select Case strWrap
Case "Ask"
If MsgBox("Word has reached the end of the document. " & lngCount & "
replacements were made." _
& " Do you want to continue searching at the beginning?",
vbQuestion + vbYesNo, "Microsoft Office Word") = vbYes Then
Call FrontPiece(oRngFront)
End If
Case "Continue"
Call FrontPiece(oRngFront)
End Select
MsgBox "Word has completed its search of the document and has made " &
lngCount & " replacements."
End Sub
Sub BackPiece(ByRef oRange As Word.Range)
With oRange.Find
.ClearFormatting
.Text = "test"
If strReplace = "^&" Then strReplace = .Text
.MatchWholeWord = True
While .Execute
If .Found Then
lngCount = lngCount + 1
lngCase = oRange.Case
With oRange
.Text = strReplace
.Case = lngCase
.Collapse wdCollapseEnd
End With
End If
Wend
End With
End Sub
Sub FrontPiece(ByRef oRange As Word.Range)
With oRange.Find
.ClearFormatting
.Text = "test"
If strReplace = "^&" Then strReplace = .Text
.MatchWholeWord = True
While .Execute
If .Found Then
If oRange.InRange(oRngCheck) Then
lngCount = lngCount + 1
lngCase = oRng.Case
With oRange
.Text = strReplace
.Case = lngCase
.Collapse wdCollapseEnd
End With
End If
End If
Wend
End With
End Sub

--
Greg Maxey

See my web site http://gregmaxey.mvps.org
for an eclectic collection of Word Tips.

Arrogance is a weed that grows mostly on a dunghill (Arabic proverb)