VBA获取word文档中的所有超链接答案

【问题标题】：VBA get all hyperlinks in word documentVBA获取word文档中的所有超链接
【发布时间】：2013-10-02 19:51:55
【问题描述】：

我正在尝试使用 Visual Basic 使用宏更新 word 文档中的所有超链接。我的代码仅更新不在文本框内的超链接，并且不会更改其中的超链接。如何更改所有超链接，包括任何文本框内的超链接？我使用此代码获取我的超链接：

 Sub UpdateLinks()
  Dim oLink As Hyperlink
  links = 0
  For Each oLink In ActiveDocument.Hyperlinks
    oLink.Range.Bold = 0
    oLink.Range.Italic = 0
    oLink.Range.Underline = wdUnderlineNone
    oLink.Range.Font.Color = wdColorWhite
    oLink.Range.Shading.BackgroundPatternColor = wdColorGray375
    links = links + 1
  Next oLink
 End Sub

【问题讨论】：

标签： vba hyperlink ms-word

【解决方案1】：

这应该适合你：

Dim links As Integer
Sub UpdateLinks()
    links = 0
    UpdateDocLinks
    UpdateTextBoxLinks
End Sub
Sub UpdateDocLinks() 
    Dim oLink As Hyperlink
    For Each oLink In ActiveDocument.Hyperlinks
      links = links + FormatLink(oLink)
    Next oLink
End Sub
Sub UpdateTextBoxLinks()
    Dim i As Integer
    Dim oLink As Hyperlink
    For i = 1 To ActiveDocument.Shapes.Count
        ActiveDocument.Shapes(i).Select
        For Each oLink In Selection.Hyperlinks
            links = links + FormatLink(oLink)
        Next oLink
    Next i
End Sub

Function FormatLink(link As Hyperlink) As Integer
     With link.Range
         .Bold = 0
         .Italic = 0
         .Underline = wdUnderlineNone
         .Font.Color = wdColorWhite
         .Shading.BackgroundPatternColor = wdColorGray375
      End With
      FormatLink = 1
End Function

干燥版本

Dim links As Integer
Sub UpdateLinks()
    links = 0
    UpdateDocLinks
    UpdateTextBoxLinks
End Sub
Sub UpdateDocLinks()
    UpdateLinkSet ActiveDocument.Hyperlinks
End Sub
Sub UpdateTextBoxLinks()
    Dim i As Integer
    For i = 1 To ActiveDocument.Shapes.Count
        ActiveDocument.Shapes(i).Select
        UpdateLinkSet Selection.Hyperlinks
    Next i
End Sub
Sub UpdateLinkSet(link_set As Variant)
    Dim oLink As Hyperlink
    For Each oLink In link_set
        FormatLink oLink
    Next oLink
End Sub
Sub FormatLink(link As Hyperlink)
    With link.Range
       .Bold = 0
       .Italic = 0
       .Underline = wdUnderlineNone
       .Font.Color = wdColorWhite
       .Shading.BackgroundPatternColor = wdColorGray375
    End With
    links = links + 1
End Sub

【讨论】：

非常感谢，所以您创建了另一个函数，该函数遍历所有形状并在其中查找超链接。为什么你把它们中的一些作为 Sub 而一些作为 Function？
函数返回一个值，所以为了更简洁，我告诉它为它格式化的每个链接返回 1。我本可以将链接放入函数中并将其更改为子例程，然后调用 FormatLink(oLink) 实际上会更干燥。如果您愿意，我可以编辑回复。
添加它只是为了方便您查看