VBA Hyperlinks.AddでExcelのセルにハイパーリンクを自動設定！基本から応用まで解説

Sub AddHyperlink()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), _
        Address:="https://www.yahoo.co.jp", _
        TextToDisplay:="Yahoo!"
End Sub

Sub AddFileLink()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), _
        Address:="C:\サンプル\サンプル1.xlsx", _
        TextToDisplay:="別ファイルを開く"
End Sub

Sub AddSubAddressLink()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), _
        Address:="", _
        SubAddress:="'Sheet2'!B2", _
        TextToDisplay:="Sheet2のB2に移動"
End Sub

Sub AddHyperlinkWithTooltip()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), _
        Address:="https://www.yahoo.co.jp", _
        ScreenTip:="このリンクはサンプル用です", _
        TextToDisplay:="サンプルリンク"
End Sub

Sub AddEmailLink()
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), _
        Address:="mailto:someone@example.com?subject=お問い合わせ", _
        TextToDisplay:="メール送信"
End Sub

Sub GetHyperlinkAddress()
    Dim linkAddress As String
    
    '// セルA1のハイパーリンク先を取得
    On Error Resume Next '// ハイパーリンクがない場合のエラー回避
    linkAddress = ActiveSheet.Range("A1").Hyperlinks(1).Address
    On Error GoTo 0
    
    '// 結果をメッセージボックスで表示
    If linkAddress <> "" Then
        MsgBox "ハイパーリンクのアドレス: " & linkAddress
    Else
        MsgBox "ハイパーリンクが設定されていません。"
    End If
End Sub

Sub ListAllHyperlinks()
    Dim ws As Worksheet
    Dim linkWs As Worksheet
    Dim link As Hyperlink
    Dim i As Long
    
    '// 出力先のシートを作成
    Set ws = ActiveSheet
    Set linkWs = ThisWorkbook.Sheets.Add
    linkWs.Name = "リンク一覧"
    
    '// ヘッダーを設定
    linkWs.Range("A1").Value = "セル番地"
    linkWs.Range("B1").Value = "リンク先"
    i = 2 ' 出力開始行
    
    '// ハイパーリンクを取得して出力
    For Each link In ws.Hyperlinks
        linkWs.Cells(i, 1).Value = link.Parent.Address '// セル番地
        linkWs.Cells(i, 2).Value = link.Address '// リンク先
        i = i + 1
    Next link
    
    MsgBox "ハイパーリンク一覧を作成しました！"
End Sub

Sub RemoveHyperlink()
    '// セルA1のハイパーリンクを削除
    On Error Resume Next '// ハイパーリンクがない場合のエラー回避
    ActiveSheet.Range("A1").Hyperlinks(1).Delete
    On Error GoTo 0
    MsgBox "ハイパーリンクを削除しました！"
End Sub

Sub SafeHyperlinkCheck()
    Dim linkAddress As String
    
    On Error Resume Next
    linkAddress = ActiveSheet.Range("A1").Hyperlinks(1).Address
    On Error GoTo 0
    
    If linkAddress <> "" Then
        MsgBox "リンク先: " & linkAddress
    Else
        MsgBox "ハイパーリンクが設定されていません。"
    End If
End Sub

Sub UseCellForHyperlink()
    Dim linkAddress As String
    
    '// セルB1にリンク先URLを記載しておく
    linkAddress = ActiveSheet.Range("B1").Value
    
    '// セルA1にハイパーリンクを設定
    ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), _
        Address:=linkAddress, _
        TextToDisplay:="リンク"
End Sub

Sub FastHyperlinkDeletion()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    '// 処理対象のシートと範囲を設定
    Set ws = ActiveSheet
    Set rng = ws.UsedRange
    
    '// 画面更新を停止
    Application.ScreenUpdating = False
    
    '// 範囲内のすべてのハイパーリンクを削除
    On Error Resume Next
    For Each cell In rng
        cell.Hyperlinks.Delete
    Next cell
    On Error GoTo 0
    
    '// 画面更新を再開
    Application.ScreenUpdating = True
    
    MsgBox "すべてのハイパーリンクを削除しました！"
End Sub

Sub ClickAllHyperlinks()
    Dim ws As Worksheet
    Dim link As Hyperlink
    
    '// 現在のアクティブシートを設定
    Set ws = ActiveSheet
    
    '// アクティブシート内のすべてのハイパーリンクを実行
    For Each link In ws.Hyperlinks
        link.Follow '// ハイパーリンクをクリック（実行）
    Next link
    
    MsgBox "すべてのハイパーリンクをクリックしました！"
End Sub

Sub ListFilesWithHyperlinks()
    Dim fd As FileDialog
    Dim folderPath As String
    Dim fileName As String
    Dim ws As Worksheet
    Dim i As Long
    
    '// アクティブシートを変数にセット
    Set ws = ActiveSheet
    
    '// フォルダ選択ダイアログの設定
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "フォルダを選択してください"
    
    '// ダイアログを表示し、フォルダが選択された場合の処理
    If fd.Show = -1 Then
        folderPath = fd.SelectedItems(1) & "\" '// 選択されたフォルダパスを取得
    Else
        MsgBox "フォルダが選択されませんでした。", vbExclamation, "中止"
        Exit Sub
    End If
    
    '// ヘッダーの設定
    ws.Cells(1, 1).Value = "ファイル名"
    ws.Cells(1, 2).Value = "ハイパーリンク"
    i = 2 ' データ出力の開始行
    
    '// フォルダ内のすべてのファイルを取得
    fileName = Dir(folderPath & "*.*") '// フォルダ内の最初のファイルを取得
    Do While fileName <> ""
        '// ファイル名をA列に記載
        ws.Cells(i, 1).Value = fileName
        '// ハイパーリンクをB列に設定
        ws.Hyperlinks.Add Anchor:=ws.Cells(i, 2), _
            Address:=folderPath & fileName, _
            TextToDisplay:="開く"
        i = i + 1
        fileName = Dir() '// 次のファイルを取得
    Loop
    
    MsgBox "ファイルリストとハイパーリンクを作成しました！", vbInformation, "完了"
End Sub