トップ 一覧 ping 検索 ヘルプ RSS ログイン

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 = "MS Pゴシック"
         .Size = 10
         .Strikethrough = False
         .Superscript = False
         .Subscript = False
         .OutlineFont = False
         .Shadow = False
         .Underline = xlUnderlineStyleSingle
         .ColorIndex = 5
     End With
     
 End Sub