セル上にファイルやフォルダ一覧を作成した時の追加機能としてフォルダを開くを追加したいと思います。
いちいちディレクトリをコピーしたりハイパーリンクにするのは面倒ですからね。
普通にダブルクリックするとセルの編集になりますが、今回はセルの編集をキャンセルしつつ、フォルダを開くメッセージボックスを表示します。
ソースコード
この機能を追加したいシートモジュールに記載してください。
セルをダブルクリックした時に発生するWorksheet_BeforeDoubleClickイベントの中に記載します。
ThisWorkbookであればブック全体で有効になります。（その場合は、Workbook_SheetBeforeDoubleClickに記載します。）
セルの値がフォルダであればそのまま開きます。
ファイルであれば親フォルダを開きます。
どちらでもない場合は、開かずそのままセルの編集ができるようにキャンセルしません。
※下記はWindowsのエクスプローラーで開く例です。
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Call LinkFolder(Target, Cancel)
End Sub
Sub LinkFolder(ByVal Target As Range, Cancel As Boolean)
Dim OpenFolder As String
Dim FSO As New Scripting.FileSystemObject
Dim rc As Integer
Dim msg As String
On Error GoTo Err_Exit
OpenFolder = Target.Value
If FSO.FolderExists(OpenFolder) = True Then
msg = "フォルダを開きますか？"
Else
OpenFolder = FSO.GetParentFolderName(OpenFolder)
If FSO.FolderExists(OpenFolder) = True Then
msg = "親フォルダを開きますか？"
Else
Exit Sub
End If
End If
rc = MsgBox(msg, vbYesNo + vbInformation, "フォルダを開く")
Select Case (rc)
Case vbYes
Shell "C:Windowsexplorer.exe " & OpenFolder, vbNormalFocus
Case Else
End Select
Cancel = True
Exit Sub
Err_Exit:
MsgBox "予期せぬエラー" & Err.Number, vbCritical, "エラー"
End Sub検証環境
Microsoft Office 2010 および 2016で検証しています。
