Excel VBA シート名を指定してハイパーリンクを作成

Excel VBA シート名を指定してハイパーリンクを作成

[Excel][Excel VBA]

シート名を指定してハイパーリンクを作成する

Sub CreateHyperLink()
    Dim sht_name As String
    Dim lnk_name As String
    Dim i        As Integer
    Dim hit      As Boolean
    
    sht_name = InputBox("シート名を入力")
    If Trim(sht_name) = "" Then
        Exit Sub
    End If
    sht_name = RTrim$(sht_name)
    
    hit = False
    For i = 1 To ActiveWorkbook.Sheets.Count
        If ActiveWorkbook.Sheets(i).Name = sht_name Then
            hit = True
        End If
    Next
    If Not hit Then
        Call MsgBox("一致するシートが存在しません", vbExclamation)
        Exit Sub
    End If
    
    lnk_name = "'" & sht_name & "'!A1"
    
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=lnk_name
    With Selection.Font
        .Name = "ＭＳ Ｐゴシック"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleSingle
        .ColorIndex = 5
    End With
    
End Sub