vba - 在 Excel 中使用 VBA 打开超链接（运行时错误 9）

Question

我正在尝试使用 VBA 使用以下代码从我的 excel 打开超链接：

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
    numRow = numRow + 1
Loop

但是，我一直Runtime Error 9: Subscript out of range在关注超链接的代码点。

我对 VBA 宏制作很陌生（因为以前从未做过），所以我们将不胜感激。（如果有更好的方法从单个列中的每个单元格打开链接，我也会很高兴了解这一点）

编辑（添加更多信息）

有问题的超链接是使用 HYPERLINK Worksheet 函数创建的，并且文本不显示链接 URL。工作表数据示例如下所示：

它看起来像什么

案例------链接
案例 1-----总结
案例2-----总结案例3-----
总结

但是，显示文本“摘要”的单元格包含一个公式

=HYPERLINK("whateverthebaseurlis/"&[@[Case]]&"/Summary", "Summary")

这是必须遵循的链接。该链接有效，可以手动跟踪。但我需要通过宏来完成

谢谢

score 5 · Accepted Answer

您可能会收到错误，因为您有一些带有文本但没有链接的单元格！

检查链接而不是单元格是否为文本：

numRow = 1
Do While ActiveSheet.Range("E" & numRow).Hyperlinks.Count > 0
    ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow
    numRow = numRow + 1
Loop

score 1 · Accepted Answer

久经考验

假设

我在这里介绍了 3 个场景，如 Excel 文件中所示。

=HYPERLINK("www."&"Google"&".Com","Google"). 这个超链接有一个好记的名字
www.Google.com普通超链接
=HYPERLINK("www."&"Google"&".Com") 此超链接没有友好名称

截屏：

在此处输入图像描述

逻辑：

检查它是什么样的超链接。如果它不是具有友好名称的，那么代码非常简单
如果超链接有一个友好的名称，那么代码尝试做的是从中提取文本"www."&"Google"&".Com"，=HYPERLINK("www."&"Google"&".Com","Google")然后将其作为公式存储在该单元格中
一旦公式将上述文本转换为普通超链接，即没有友好名称，我们就可以使用它打开它ShellExecute
重置单元格的原始公式

代码：

Private Declare Function ShellExecute _
Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, ByVal Operation As String, _
ByVal Filename As String, Optional ByVal Parameters As String, _
Optional ByVal Directory As String, _
Optional ByVal WindowStyle As Long = vbMinimizedFocus _
) As Long

Sub Sample()
    Dim sFormula As String
    Dim sTmp1 As String, sTmp2 As String
    Dim i As Long
    Dim ws As Worksheet

    '~~> Set this to the relevant worksheet
    Set ws = ThisWorkbook.Sheets(1)

    i = 1

    With ActiveSheet
        Do While WorksheetFunction.IsText(.Range("E" & i))
            With .Range("E" & i)
                '~~> Store the cells formula in a variable for future use
                sFormula = .Formula

                '~~> Check if cell has a normal hyperlink like as shown in E2
                If .Hyperlinks.Count > 0 Then
                    .Hyperlinks(1).Follow
                '~~> Check if the cell has a hyperlink created using =HYPERLINK()
                ElseIf InStr(1, sFormula, "=HYPERLINK(") Then
                    '~~> Check if it has a friendly name
                    If InStr(1, sFormula, ",") Then
                        '
                        ' The idea here is to retrieve "www."&"Google"&".Com"
                        ' from =HYPERLINK("www."&"Google"&".Com","Google")
                        ' and then store it as a formula in that cell
                        '
                        sTmp1 = Split(sFormula, ",")(0)
                        sTmp2 = "=" & Split(sTmp1, "HYPERLINK(")(1)

                        .Formula = sTmp2

                        ShellExecute 0, "Open", .Text

                        '~~> Reset the formula
                        .Formula = sFormula
                    '~~> If it doesn't have a friendly name
                    Else
                        ShellExecute 0, "Open", .Text
                    End If
                End If
            End With
            i = i + 1
        Loop
    End With
End Sub

score 1 · Accepted Answer

获取单元格超链接的更清洁方法：

使用Range.Value(xlRangeValueXMLSpreadsheet)，可以在 XML 中获取单元格超链接。因此，我们只需要解析 XML。

'Add reference to Microsoft XML (MSXML#.DLL)
Function GetHyperlinks(ByVal Range As Range) As Collection
    Dim ret As New Collection, h As IXMLDOMAttribute
    Set GetHyperlinks = ret
    With New DOMDocument
        .async = False
        Call .LoadXML(Range.Value(xlRangeValueXMLSpreadsheet))
        For Each h In .SelectNodes("//@ss:HRef")
            ret.Add h.Value
        Next
    End With
End Function

所以你可以在你的代码中使用这个函数：

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    FollowHyperlink GetHyperlinks(ActiveSheet.Range("E" & numRow))
    numRow = numRow + 1
Loop

如果你不需要numRow，你可以：

Dim h as String
For Each h In GetHyperlinks(ActiveSheet.Range("E:E"))
    FollowHyperlink h
Next

对于FollowHyperlink，我建议使用以下代码 - 您还有其他答案的其他选项：

Sub FollowHyperlink(ByVal URL As String)
    Shell Shell "CMD.EXE /C START """" """ & URL & """"
End Sub

score 1 · Accepted Answer

如果它在您尝试打开超链接时抛出错误，请尝试使用 explorer.exe 显式打开它

Shell "explorer.exe " & Range("E" & numRow).Text

Hyperlinks(1).Follow不起作用的原因是单元格中没有传统的超链接，因此它将返回超出范围

numRow = 1
Do While WorksheetFunction.IsText(Range("E" & numRow))
    URL = Range("E" & numRow).Text
    Shell "C:\Program Files\Internet Explorer\iexplore.exe " & URL, vbNormalNoFocus
    numRow = numRow + 1
Loop

检查这篇文章是否有类似的问题： http ://www.mrexcel.com/forum/excel-questions/381291-activating-hyperlinks-via-visual-basic-applications.html

vba - 在 Excel 中使用 VBA 打开超链接（运行时错误 9）

4 回答 4

Related

Reference