在 Excel VBA 问题中打开超链接答案

【问题标题】：Opening Hyperlinks in Excel VBA issue在 Excel VBA 问题中打开超链接
【发布时间】：2021-07-29 14:44:22
【问题描述】：

我一直在尝试查找/编写一个宏，它可以一次打开所选范围内包含的所有超链接。我遇到的代码仅适用于某些类型的超链接，特别是通过右键单击/插入>链接/Ctrl+K 添加的超链接。该代码无法识别使用 HYPERLINK() 函数形成的任何超链接。

这是我在网上找到的代码：

Sub OpenMultipleLinks()
    On Error Resume Next
    Set myRange = Application.Selection
    Set myRange = Application.InputBox("Range", "OpenMultipleLinks", myRange.Address, Type:=8)
    For Each oneLink In myRange.Hyperlinks
        oneLink.Follow
    Next
End Sub

这是变成超链接的单元格的公式。

=IF($D2="All Charts","",HYPERLINK("http://SubstituteWebsite/ChartId="&$D2&$AF$1,"link"))

【问题讨论】：

Hyperlinks 集合仅包含插入的超链接。另一个是Formula。公式的HYPERLINK 部分只能在特殊情况下起作用。在你的情况下，只有$D2="All Charts"。即使不满足此条件，您是否愿意关注超链接？您是否要评估整个公式并仅在条件为真时点击超链接？如果是，那么只有当我们可以假设您向我们展示的公式是适用于所有公式的一般模式时，这才是可能的。那么，从这个角度来看，您需要什么？
那么，您的所有公式都尊重您发布的模式吗？我的意思是，链接字符串是从根与两个串联单元值的串联构建的......
我选择的所有单元格都将遵循此结构，$D2 单元格是图表 ID，$AF$1 单元格是用于创建有效链接的文本字符串的后半部分。如果chartID 改为“所有图表”，则该公式将返回空白，因为来自某些图表的数据与存储数据的位置相同。我认为 excel 在这两种情况下都奇怪地创建了超链接，因为我无法向这些“空白”单元格添加超链接。我想要的是一个可以为我打开所有这些链接的宏。
那么，你测试我发布的解决方案了吗？

标签： excel vba hyperlink

【解决方案1】：

由于您没有回答我的澄清问题，我将假设我的理解是正确的。因此，如果您的包含“HYPERLINK”公式的公式尊重您向我们展示的模式并且应该遵循它而不评估公式条件是否为True，则以下代码将起作用：

Sub OpenMultipleLinks()
    Dim myrange As Range, cel As Range, oneLink
    On Error Resume Next
     Set myrange = Application.Selection
     Set myrange = Application.InputBox("Range", "OpenMultipleLinks", myrange.Address, Type:=8)
     For Each oneLink In myrange.Hyperlinks
          oneLink.Follow
     Next
    On Error GoTo 0
    For Each cel In myrange
        If InStr(cel.Formula, "HYPERLINK") > 0 Then
            ActiveWorkbook.FollowHyperlink extractHypFromFormula(ActiveCell.Formula)
        End If
    Next
End Sub

Function extractHypFromFormula(strForm As String) As String
    Dim Hpos As Long, startP As Long, Hlength As Long, strRoot As String
    Dim startP2 As Long, cellsAddr As String
    Hpos = InStr(strForm, "HYPERLINK") 'it returns position of the first character for "HYPERLINK" string in the formula
    If Hpos > 0 Then
         startP = Hpos + Len("HYPERLINK") + 2 'it builds the position after which to start searching
                                                               '+ 2 because of '(' and "
         Hlength = InStr(startP, strForm, """") - startP 'length of the hyperlink fix part (before the strings taken from the two cells value)
         strRoot = Mid(strForm, startP, Hlength) 'it returns the hyperlink fix part
         startP2 = startP + Len(strRoot) + 2      'next START to return the string keeping the concatenation of the two cells value
         cellsAddr = Mid(strForm, startP2, InStr(startP2, strForm, ",") - startP2) 'the string keeping the concatenation of the two cells value
         'split the string on "&" separator and use the two elements as range string:
         extractHypFromFormula = strRoot & Range(Split(cellsAddr, "&")(0)).value & Range(Split(cellsAddr, "&")(1)).value
    End If
End Function

请在测试后发送一些反馈...

【讨论】：

这很好用，谢谢！你知道我如何让它们一起在新窗口中打开吗？
@Elis 从理论上讲，是的。实际上，我从来没有看到它打开一个新窗口。它可能只在 Internet Explorer 中以这种方式运行。只是一个假设......如果你想尝试它很简单。创建一个新变量Dim count As Long，然后像迭代的第一行一样输入count = count + 1。 If count = 1 Then ActiveWorkbook.FollowHyperlink Address:=extractHypFromFormula(ActiveCell.Formula), NewWindow:=True。但是，就像我说的，它应该工作，但它没有。问微软，为什么...
我知道Hlength = InStr(startP, strForm, """") - startP这行查找超链接的字符串部分的长度（在我的代码示例中为SubstituteWebsite/ChartId=），""""部分如何实现这一点？我认为"""" 给出了一个等于“”的字符串，但是在我的公式文本字符串中，永远不会出现2“”的情况，只有一个？我的理解是 InStr 接受输入 InStr({position in string to start searching from}, {string to search in},{string expression being searched for})。
现在我在开车……等我在家的时候，我会评论代码。
@Elis 以某种方式对函数行进行了评论，以了解它们各自的作用。

【解决方案2】：

您需要首先解析/评估“超链接”公式。假设您所有的链接都在 col A 中，这将满足您的要求：

    Sub link()
        Dim arr, arr2, j As Long
        arr = Sheet1.Range("A1").CurrentRegion.Formula2 'get all in an array
        For j = 1 To UBound(arr)
            If Left(arr(j, 1), 3) = "=HY" Then 'check if it's a formula
                arr(j, 1) = Evaluate(Split(Mid(arr(j, 1), 2), ",")(0) & ")") 'split the url from the rest, evaluate and replace in array
            End If
            ActiveWorkbook.FollowHyperlink Address:=arr(j, 1), NewWindow:=True 'open in default browser
        Next j
    End Sub

祝你好运，

塞西

【讨论】：