用于在 Word 文档中搜索字符串并将其更改为超链接的宏

Question

我有一个 Word 宏，它将在 Word 文档中搜索字符串，然后将其更改为超链接。我遇到的问题是我需要在文档中搜索多个字符串并用它们自己的超链接替换每个字符串。我的宏将找到第一个字符串并将每个超链接放在另一个之后。我认为这应该是一个简单的修复方法。例如，我只包含了需要更改为超链接的 19 个字符串中的 2 个。它们可以单独工作，但如果全部在宏中则不行。这是一个Word宏。

Sub Add_Hyperlinks()
'
' Add_Hyperlinks Macro
'
'
' Certified Water Professionals

    Dim linkText As String
    Dim link As String
    Dim foundsomething As Range
    
    linkText = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    link = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=link, SubAddress:="", ScreenTip:="", TextToDisplay:=linkText
    
' Compliance
    linkText = "https://wqcdcompliance.com"
    link = "https://wqcdcompliance.com"
    
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "https://wqcdcompliance.com"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute

    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=link, SubAddress:="", ScreenTip:="", TextToDisplay:=linkText
    
End Sub

Answer 1

这可能不是最佳选择，因为我完全不是 Word VBA 人员，但它对我有用：

Sub Add_Hyperlinks()

    Dim doc As Document
    
    Set doc = ActiveDocument
    
    Linkify doc, "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals", _
                 "http://www.xxx.gov/cdphe/ccwp-certified-water-professionals"
    
    Linkify doc, "https://wqcdcompliance.com", _
                 "https://wqcdcompliance.com"
                 
    'etc for other links....
    
End Sub

'Find all instances of text `findWhat` in document `doc`, and
'  apply a hyperlink using URL `linkURL`
Sub Linkify(doc As Document, findWhat As String, linkURL As String)
    Dim rng As Range, col As New Collection, i As Long
    Set rng = doc.Range
    ResetFind rng.Find
    Do While rng.Find.Execute(findtext:=findWhat)
       ' `rng` is now the found text
       col.Add rng.Duplicate 'collect all found ranges
    Loop
    Debug.Print col.Count & " instances of '" & findWhat & "'"
    For i = col.Count To 1 Step -1 'link all found ranges
        doc.Hyperlinks.Add Anchor:=col(i), Address:=linkURL, _
          SubAddress:="", ScreenTip:="", TextToDisplay:=col(i).Text
    Next i
End Sub

Sub ResetFind(f As Find)
    With doc.Range.Find
        .ClearFormatting
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
End Sub