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 ワークシート関数を使用して作成されており、テキストにはリンク URL が表示されません。ワークシート データのサンプルは次のようなものです。

それはどのようなものか

ケース------リンク
Case1----- まとめ
Case2----- まとめ
Case3----- まとめ

ただし、「概要」というテキストを表示しているセルには数式が含まれています

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

そして、これは従わなければならないリンクです。リンクは機能し、手動でたどることができます。しかし、私はマクロを介してそれを行う必要があります

ありがとう

Answer 1

セルのハイパーリンクを取得するよりクリーンな方法:

を使用する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

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

試行錯誤

仮定

ここでは、Excel ファイルに示されている 3 つのシナリオについて説明します。

1. =HYPERLINK("www."&"Google"&".Com","Google"). このハイパーリンクにはわかりやすい名前が付けられています
2. www.Google.com通常のハイパーリンク
3. =HYPERLINK("www."&"Google"&".Com") このハイパーリンクにはフレンドリ名がありません

スクリーンショット:

論理：

1. ハイパーリンクの種類を確認してください。フレンドリ名以外の場合、コードは非常に簡単です
2. "www."&"Google"&".Com"ハイパーリンクにわかりやすい名前が付けられている場合、コードはテキストを抽出=HYPERLINK("www."&"Google"&".Com","Google")して、そのセルに数式として保存しようとします。
3. 式が上記のテキストを通常のハイパーリンク、つまりフレンドリ名なしに変換したら、次を使用して開きますShellExecute
4. セルの元の数式をリセットする

コード：

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