Find a word and add link to it

[misticmoon]

Hi,

I want to search for a word in a document, select all the instances of that word and link them to the top of the document. I am trying this:

[VBA] With ActiveDocument.Content.Find
.ClearFormatting
.MatchWholeWord = True
.Execute FindText:="Go To Top"
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
SubAddress:="Top", TextToDisplay:= "Selection.Text"
End If
End With [/VBA]
This is not working because I think is just selecting the first instance.

Thanks.

misticmoon:rofl

[Howard Kaikow]

You need to put your code in a loop.

Steve Roman's book Writing Word Macros has a useful explanation of using the Find object.

Also, see http://www.standards.com/index.html?WordVBABooks.

[Anne Troy]

I have Roman's book right here in front of me...his "useful explanation of using the Find object" is nothing more than how to manipulate the Find Object...that's it. It isn't so great...

[Howard Kaikow]

I have Roman's book right here in front of me...his "useful explanation of using the Find object" is nothing more than how to manipulate the Find Object...that's it. It isn't so great...

the book has a chapter on the find/replace objects.
very useful.

[Anne Troy]

mistic: I assume you need an answer on this, and don't have time to learn about objects. That's why this forum is here. I am getting this code for you. Hang tight.

And here you go. Courtesy of smozgur:

[VBA]
Sub CreateGoToTop()
Dim strFindText As String

Application.ScreenUpdating = False
'Text to find
strFindText = "Go To Top"
'Goto top of the page first
Selection.HomeKey Unit:=wdStory

'Settings for find action
With Selection.Find
.ClearFormatting
.MatchWholeWord = True
.Forward = True
.Wrap = wdFindContinue
'First execution
.Execute FindText:=strFindText
'Go ahead until there is no more found
Do While .Found
'Create hyperlink
'No need TextToDisplay since you just want to add hyperlink
'but not change the text to be shown
If Selection.Hyperlinks.Count = 0 Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
SubAddress:="_top", ScreenTip:=""
End If
'Execute for next find
.Execute FindText:=strFindText
Loop
End With
'Goto top of the page again
Selection.HomeKey Unit:=wdStory

Application.ScreenUpdating = True

End Sub
[/VBA]