Find and Replace and the dreaded bookmark

[Greg Maxey]

I need to perform a find and replace operation on text. Some of the "find"
words are also bookmarked. When the replace operation takes place the
bookmarks are waxed.

Example: This test is a test to test this macro. Each "test" is
bookmarked. If I run

Sub Test()
Dim myRange As Range
Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Test"
.Replacement.Text = "Test"
.Replacement.Font.Bold = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

End Sub

All of the bookmarks are waxed.

The only solution I can find is is to first grow the range of each bookmark
to include the following space then do the replacement.

Sub GrowBM()
Dim bMark As Bookmark
Dim myRange As Range
For Each bMark In ActiveDocument.Bookmarks
Set myRange = bMark.Range
If bMark.Range.Characters.Last <> Chr(32) Then
myRange.MoveEnd Unit:=wdCharacter, Count:=1
myRange.Select
ActiveDocument.Bookmarks.Add Name:=bMark.Name, Range:=Selection.Range

End If
Next
End Sub

Does anyone have a better suggestion?

Thanks.

 

[Helmut Weber]

Hi Greg,
how about this one?

Dim strBkm As String
Dim myRange As Range
Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
With myRange.Find
.Text = "Test"
While .Execute
With myRange
If .Bookmarks.Count = 1 Then
strBkm = .Bookmarks(1).Name
.Text = "Experiment"
.Font.Bold = True
.Bookmarks.Add Name:=strBkm
.Collapse direction:=wdCollapseEnd
End If
End With
Wend
End With

You certainly don't need assistance to handle all search options.
Beware of bookmarks which include or overlap other bookmarks.
Then things might get out of control.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Helmut Weber]

Hi Greg,

once again I was too fast.
We have to take care of not bookmarked "Test" also:

Dim strBkm As String
Dim myRange As Range
Set myRange = ActiveDocument.StoryRanges(wdMainTextStory)
With myRange.Find
.Text = "Test"
While .Execute
With myRange
If .Bookmarks.Count = 1 Then
strBkm = .Bookmarks(1).Name
.Text = "Experiment"
.Font.Bold = True
.Bookmarks.Add Name:=strBkm
End If
If .Bookmarks.Count = 0 Then
.Text = "Experiment"
.Font.Bold = True
End If
.Collapse direction:=wdCollapseEnd
End With
Wend
End With

Regards

Helmut

 

[Greg Maxey]

Helmut,

Perfect. I have incorporated this process in a larger macro and it performs
flawlessly. Thanks.