在 Excel VBA 问题中打开超链接

Question

我一直在尝试 find/write 一个宏，它可以一次打开选定范围内包含的所有超链接。我遇到的代码仅适用于某些类型的超链接，特别是通过右 click/Insert>Link/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,"link"))

Answer 1

您需要先parse/evaluate“超链接”公式。假设您所有的链接都在 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

祝你好运，

西西

Answer 2

既然你没有回答我的澄清问题，我就认为我的理解是正确的。因此，如果您的包含 '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

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

在 Excel VBA 问题中打开超链接

Opening Hyperlinks in Excel VBA issue

excel

vba

hyperlink