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工作表功能创建了相关超链接，文本未显示链接网址。工作表数据样本如下：

它看起来像什么

案例 ------ 链接
案例1 -----摘要
案例2 -----摘要
案例3 -----摘要

显示文本“摘要”的单元格包含公式

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

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

来做到这一点

由于

Answer 1

可能是因为你有一些带有文字但没有链接的单元格而出现错误！

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

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

Answer 2

如果在您尝试打开超链接时抛出错误，请尝试使用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

Answer 3

已经过测试

<强>假设

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

=HYPERLINK("www."&"Google"&".Com","Google")。此超链接具有友好名称
www.Google.com普通超链接
=HYPERLINK("www."&"Google"&".Com")此超链接没有友好名称

<强>截图：

enter image description here

<强>逻辑：

检查它是什么类型的超链接。如果它不是具有友好名称，那么代码非常简单
如果超链接具有友好名称，则代码尝试执行的操作是从"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

Answer 4

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

使用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

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

4 个答案: