使用 vba 为名称添加超链接答案

【问题标题】：Adding hyperlinks to names with vba使用 vba 为名称添加超链接
【发布时间】：2015-04-18 10:04:26
【问题描述】：

我的 VBA 技能不存在，而且我找不到任何适合我的情况的线程，因此这个线程。

我在 Excel 工作表中有一个包含名称的列（B 列），我正在尝试将 B 中的单元格超链接到网页。每一行都有一个特定的网页。

如果我有一个包含所有相应 URL 的列，那么使用 HYPERLINK 函数会很容易，但问题是电子表格的最终版本将没有包含 URL 的列。

最终版本将包括以下内容：（B 列）超链接到特定网页的名称，以及（A 列）包含 URL 的唯一部分以及 B 中的名称的 ID

除了末尾的数字之外，所有 URL 都是相同的。不变的部分是：

http://www.regulations.gov/#!documentDetail;D=CFPB-2011-0008

每个网址的末尾都有一个四位数。

以“CFPB”开头并以四位数字结尾的位是要包含在 A 列中的部分。

所以我的计划是编写一个 VBA 程序，使用从

构造的 URL 将超链接添加到 B

http://www.regulations.gov/#!documentDetail;D=

以及 A 中相应单元格的前部（例如 CFPB-2011-0008-0002）。我正在考虑使用 LEFT 函数从 A 获取 URL 的第二部分（例如 LEFT(A1,19)）。

抱歉，如果解释不清楚...任何帮助将不胜感激。

【问题讨论】：

不会工作。由于 URL 中的 #。 support.microsoft.com/en-us/kb/202261
@AxelRichter - 适用于 URL（至少当我在 Excel 2010 中尝试时）。唯一奇怪的是工具提示用连字符替换了#，但单击时它仍然加载了正确的页面。链接的知识库仅指在文件名中使用#。
@Comintern。您的答案不适用于 Excel 2007。超链接调用 http://www.regulations.gov/%20-%20!documentDetail;D=CFPB-2011-0008 失败。
@AxelRichter - 很有趣。我想知道他们是否在 Excel 2010 中解决了这个问题。
@Comintern：似乎是 Excel 2007 和 IE 11 作为默认浏览器组合的问题。使用 Chrome 作为默认浏览器，它可以工作。

标签： vba excel hyperlink

【解决方案1】：

我正确理解了这个问题，您可以使用简单的工作表功能来做到这一点。只需将 URL 连接在一起：

=HYPERLINK(CONCATENATE("http://www.regulations.gov/#!documentDetail;D=",LEFT(A1,14)))

一种仅将 URL 添加到现有文档名称的 VBA 解决方案类似于：

Sub AddHyperlinks()

    Dim url As String

    Dim current As Range
    For Each current In Selection.Cells
        url = "http://www.regulations.gov/#!documentDetail;D=" & _
              Left$(current.Value, 14)
        current.Worksheet.Hyperlinks.Add current, url
    Next current

End Sub

选择要添加超链接的单元格并运行宏。

【讨论】：

我刚刚运行了它，它运行良好，只是它看起来像显示的 url 以 A 列中名称的前 14 个字符而不是 B 列中的 ID 结尾。我会喜欢在引用 ID 时超链接名称。假设带有 ID 的列位于带有名称的列的左侧，有没有办法将 Left 函数中的 current.Value 替换为“活动单元格左侧的单元格”？非常感谢。
@hwin - 你可以用current.Offset(0, -1).Value替换current.Value

【解决方案2】：

前几天我把一个脚本放在一起做类似的事情，你会想把它放到一个循环或其他东西中，以便在电子表格中查看你的列表。我使用 iCurrentRow 和 iCurrentCol 在工作表中导航。

使用您建议的函数在您想要的单元格中构建超链接字符串，即 B 列中的单元格，然后将 strString 设置为该值。我刚刚添加了strString（尚未测试），所以如果它不起作用，那么您可能需要将它包含在CStr()中。

无论如何，它应该会给你一些工作。

' Set the string to the hyperlink address    
strString = Cells(iCurrentRow, iCurrentCol).value
' Check if the cell already has a hyperlink
If Cells(iCurrentRow, iCurrentCol).Hyperlinks.Count > 0 Then
    'If it does then check if it is the same as in the cell
     If strString  <> CStr(Cells(iCurrentRow, iCurrentCol).Hyperlinks(1).Address) Then
         'Check if there is no new hyperlink
          If strString = "" Then
              Cells(iCurrentRow, iCurrentCol).Hyperlinks.Delete
          Else
              ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
                  Address:=strString
          End If
      End If
Else
    'If there isn't an existing hyperlink then add it
     If strString <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=Cells(iCurrentRow, iCurrentCol), _
             Address:=strString 
     End If
End If

【讨论】：

【解决方案3】：

试试这个：

Sub MAIN()
    Dim rng As Range, rr As Range, r As Range
    Set rng = Intersect(Range("B:B"), ActiveSheet.UsedRange)

    For Each rr In rng
        If rr.Value <> "" Then
            Set r = rr
            Call hyper_maker(r)
        End If
    Next rr
End Sub

Sub hyper_maker(r As Range)
    If r.Hyperlinks.Count > 0 Then
        r.Hyperlinks.Delete
    End If
    txt = r.Value
    s = "http://www.regulations.gov/#!documentDetail;D=" & txt
    r.Value = s
    r.Select
    Application.SendKeys "{F2}"
    Application.SendKeys "{ENTER}"
    DoEvents
    r.Hyperlinks(1).TextToDisplay = txt
End Sub

【讨论】：