这应该适合你:
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