☰

使用 VBA 在 MS Word 中的每个超链接后以纯文本形式插入 URL

tag-icon • tag-icon microsoft-word vba hyperlink visual-basic
使用 VBA 在 MS Word 中的每个超链接后以纯文本形式插入 URL

我想在 Word 文档中链接文本旁边自动插入每个超链接的 URL。

例如，而不是： 我的超链接文本

它应该是： 我的超链接文本（https://www.google.ca）

这是我在 VBA 中编写的一些代码，它用旁边的地址替换所有链接，但这会删除原始超链接。有没有办法保留超链接，同时在其旁边的括号中附加 URL？

Dim oLink As Hyperlink
Dim strText As String
Dim strLink As String
For Each oLink In ActiveDocument.Hyperlinks
    Let strText = oLink.Range.Text
    Let strLink = oLink.Range.Hyperlinks(1).Address
    Let oLink.Range.Text = strText & " (" & strLink & ")"
Next oLink
Set oLink = Nothing

答案1

像这样：

Sub processhyperlinks1()
Dim i As Long
Dim oLink As Word.Hyperlink
Dim r As Word.Range
Dim s As String

For Each oLink In ActiveDocument.Hyperlinks
  Set r = oLink.Range
  r.Collapse WdCollapseDirection.wdCollapseEnd
  s = oLink.Address
  ' optional
  If oLink.SubAddress <> "" Then
    s = s & "#" & oLink.SubAddress
  End If
  r.Text = " (" & s & ")"
  Set r = Nothing  Set r1 = Nothing

Next
End Sub

如果您想将链接文本涂成蓝色，则需要修改范围的字体或应用相关的超链接字符样式。

如果您希望旧链接和新链接都是超链接，您可以这样开始：

Sub processHyperlinks2()
Dim i As Long
Dim r1 As Range
Dim r2 As Range
Dim s As String
i = 1
With ActiveDocument
  Do Until i > .Hyperlinks.Count
    Set r1 = .Hyperlinks(i).Range
    Set r2 = r1.Duplicate
    r2.Collapse WdCollapseDirection.wdCollapseEnd
    r2.Text = " ()"
    r2.Start = r2.Start + 2
    r2.End = r2.Start
    r2.FormattedText = r1.FormattedText
    s = .Hyperlinks(i).Address
    ' optionally include any SubAddress.
    If .Hyperlinks(i).SubAddress <> "" Then
      s = s & "#" & .Hyperlinks(i).SubAddress
    End If
    r2.Fields(1).Result.Text = s
    Set r2 = Nothing
    Set r1 = Nothing
    i = i + 2
  Loop
End With
End Sub

（当您添加正在迭代的对象类型时，您必须小心避免无限循环，有时使用例如 For i = .Hyperlinks.Count to 1 Step -1 向后工作可能也不起作用）。

如果您想确保通过对话框输入的超链接最终采用这种布局，您可能需要编写自己的用户窗体来执行您需要的标准窗体部分。（此用户窗体不是较旧的 WordBasic 窗体之一，它可让您轻松提取不同的值，例如地址、子地址、显示文本等）。

答案2

这是我之前写的一些代码：

Sub HyperLinkExpand()
    ' Charles Kenyon
    ' 16 July 2018
    ' Add text of hyperlink address to text display or substitute address for text
    ' response to question on Answers forum https://answers.microsoft.com/en-us/subject/forum/category/topic/cc65005f-b4cd-4173-8756-85d17f02c7a1
    '
    Dim oLink  As Hyperlink
    Dim strAddress As String
    Dim strLink As String
    '
    For Each oLink In ActiveDocument.Hyperlinks
        Let strAddress = oLink.Address
        Let strLink = oLink.TextToDisplay
        Let oLink.TextToDisplay = strLink & " (" & strAddress & ")"    'add url in parentheses to hyperlink
        '        oLink.TextToDisplay = strAddress ' replace text in hyperlink with url
    Next oLink
End Sub

相关内容