エクセルVBA自動ハイパーリンクフォルダー指定場所

質問

管理台帳を作成したく、下記のVBAを作りました。
マクロ内容は、Aセルに管理番号を入力しマクロ実行ボタンにて、
入力した番号と同じフォルダーを作成しハイパーリンクする自動フォルダー作成＆ハイパーリンクマクロです。
現在のフォルダー作成場所はローカルのDドライブ直下に作る様に指定しているのですが、
エクセルVBAがある場所と同じ場所に、上記のマクロで作るフォルダーが出来る様にしたいのですが、
見よう見まねでVBAを何とか作ったのですが、知識がなくこれ以上が解りません。
出来れば、下記のVBAを編集して頂、教えて頂いたVBAをそのままコピペすれば使える状態で教えて頂ければ助かります。
宜しくお願い致します。

Sub MakeHyLink()
Const path As String = "D:\"
Dim wkStr As String
If ActiveCell.Column = 1 Then
wkStr = path & ActiveCell.Value
If Dir(wkStr, vbDirectory) = vbNullString Then
MsgBox wkStr & "フォルダがありません。作成します。"
MkDir wkStr
Else
MsgBox wkStr & "フォルダは存在します。"
End If
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=wkStr
End If

回答No.2

myRange · ベストアンサー

＞Aセルに管理番号を入力し

Aセルということですから、A列であればどこでも、
かつ、該当セルをActiveにしてからマクロ実行ですね？

'--------------------------　
Sub MakeHyLink()
　Dim wkStr As String
　If ActiveCell.Column <> 1 Then Exit Sub

　If ActiveCell.Value = "" Then
　　　　MsgBox "アクティブセルは未入力、やり直し"
　　　　Exit Sub
　End If

　wkStr = ThisWorkbook.path & "\" & ActiveCell.Value

　If Dir(wkStr, vbDirectory) = "" Then
　　　　MsgBox "フォルダー：" & wkStr & vbLf & " を、作成します。"
　　　　MkDir wkStr
　Else
　　　　MsgBox "フォルダー：" & wkStr & vbLf & " は、存在します。"
　End If

　ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=wkStr

End Sub
'-------------------------------------------

以上です。

回答No.1

kmetu

現在実行中のエクセルVBAがある場所は

ThisWorkbook.Path

です。