12,665
回編集
差分
ナビゲーションに移動
検索に移動
ページの作成:「==Excel VBA シート名を指定してハイパーリンクを作成== [Excel][Excel VBA] ====シート名を指定してハイパーリンクを作成する==== S…」
==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
[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
© 2006 矢木浩人
