在Excel中使用VBA打开超链接（运行时错误9）
我正在尝试使用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在超链接的代码点处Runtime Error 9: Subscript out of range 。
我对VBA Macro-making非常陌生（就像在之前从未做过的那样），所以帮助将不胜感激。 （如果有一个更好的方法来打开一个单一列中的每个单元格的链接，我也很高兴知道这一点）
编辑（添加更多信息）
使用HYPERLINK工作表function创build了超链接，文本不显示链接URL。 工作表数据的示例是这样的：
它看起来像什么
案例 —— 链接
案例1 —–总结
案例2 —–总结
案例3 —–总结
显示“摘要”文本的单元格包含一个公式
=HYPERLINK("whateverthebaseurlis/"&[@[Case]]&"/Summary", "Summary")
这是必须遵循的链接。 链接起作用，可以手动进行。 但是我需要通过macros来完成
谢谢
如果在尝试打开超链接时出现错误，请尝试使用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
也许，你得到错误，因为你有一些单元格与文本，但没有链接！
检查链接，而不是单元格是文本：
numRow = 1 Do While ActiveSheet.Range("E" & numRow).Hyperlinks.Count > 0 ActiveSheet.Range("E" & numRow).Hyperlinks(1).Follow numRow = numRow + 1 Loop
尝试和testing
假设
我在这里覆盖3个场景，如Excel文件中所示。
-
=HYPERLINK("www."&"Google"&".Com","Google")。 这个超链接有一个友好的名字 -
www.Google.com普通超链接 -
=HYPERLINK("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
一个更干净的获取单元格的方法：
使用Range.Value(xlRangeValueXMLSpreadsheet) ，可以获得XML中的单元格超链接。 因此，我们只需要parsingXML。
'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 ，我build议下面的代码 – 你有其他select从另一个答案：
Sub FollowHyperlink(ByVal URL As String) Shell Shell "CMD.EXE /C START """" """ & URL & """" End Sub