vba - 查找并创建相似单词超链接的 Word 宏

Question

这是我的宏（Macro1）的代码：

Sub Macro1()
'
' Macro1 Macro
'
     Selection.Find.ClearFormatting
     With Selection.Find
         .Text = "REQ"
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = True
         .MatchWholeWord = False
         .MatchWildcards = False
         .MatchSoundsLike = False
         .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=8, Extend:=wdExtend
    Selection.Copy
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
    "http://www.neki.com/REQ12345678", SubAddress:="", ScreenTip:="", _
    TextToDisplay:="REQ12345678"
End Sub

该代码可以正常查找 REQxxxxxxxx 文本，但随后会粘贴错误的 TextToDisplay 和错误的地址结尾。而不是 REQ12345678 在这两个地方都应该粘贴我之前复制的相同文本：Selection.Copy。我也不知道如何创建一个循环或类似的东西，以便 Macro1 将一直运行直到它到达文档的末尾。请帮帮我！

嘿，我解决了创建超链接的第一个问题。现在我必须循环那个“超链接”宏。我决定创建另一个宏，它将循环第一个。这是我的代码：

Sub Macro2()
'
' Macro2 Macro
'

Do Until ActiveDocument.Bookmarks.Exists("Konec")
Application.Run MacroName:="Macro1"
Loop
End Sub

Macro1 工作得很好，但我无法弄清楚如何循环它直到文档结束 - 直到结束书签......

Answer 1

我使用以下代码将所选文本链接到文档中稍后出现的类似文本。

Sub Macro1()
'
' Macro1 Macro
'
'
   With Selection.Find
         .Text = Selection
         .Replacement.Text = ""
         .Forward = True
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = True
         .MatchWholeWord = True
         .MatchWildcards = True
         .MatchSoundsLike = False
         .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:=Selection
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
      With Selection.Find
         .Text = Selection
         .Replacement.Text = ""
         .Forward = False
         .Wrap = wdFindContinue
         .Format = False
         .MatchCase = True
         .MatchWholeWord = True
         .MatchWildcards = True
         .MatchSoundsLike = False
         .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=Selection, ScreenTip:="", TextToDisplay:=Selection

End Sub