Prev: Word formalize option that converts chat shortcuts into correct wo
Next: Word 2007 Forms - Plain Text Control does not accept unless you Ta
From: Greg Maxey on 12 Feb 2010 10:51 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) |