アプリ版:「スタンプのみでお礼する」機能のリリースについて

エクセルでフォルダまたはファイルを開くマクロですが、どのように改良すればよろしいでしょうか?

下記マクロは、エクセルシートのJ列のあるセルをダブルクリックすると、そのセルに記入された文字列を検索して、該当のフォルダまたは、写真が開きます。(エクセルファイルと写真は同フォルダに保存している場合のみ有効)

困っていることは、J列のセルと該当フォルダまたは、写真ファイルをリンクさせたいのですが、文字列が全て一致している時のみしか開かないことです。

D<デジカメ<商品名フォルダ<写真ファイル

例えば セルJ3の文字列がABCEで、フォルダ名またはファイル名がABCDEFであった場合、文字列ABCEを含む条件で、フォルダ名またはファイル名ABCDEFを開くように改良したいのですが、
また、エクセルファイルと写真ファイルの保存場所は、全く違うフォルダにしたいのですが、
エクセルファイルと写真ファイルは、別フォルダの場合、どのように検索先フォルダのパスを入れたら良いのでしょうか?
マクロに詳しい方ご教授下さい。よろしくお願い致します。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myPath As String

If Target.Cells(1, 1).Column <> 10 Then Exit Sub

Cancel = True
myPath = ThisWorkbook.Path & "\" & Target.Cells(1, 1).Text

If Dir(myPath, vbDirectory) <> "" Then
Shell "explorer.exe /e,/root," & myPath, vbNormalFocus
Exit Sub
End If

myPath = Replace(LCase(myPath), ".jpg", "\" & Target.Cells(1, 1).Text)

If Dir(myPath, vbNormal) <> "" Then
Shell "rundll32.exe shimgvw.dll,ImageView_Fullscreen " & myPath, vbNormalFocus
End If

End Sub

A 回答 (2件)

詳細が良く分らないので、適当です


外したらゴメンネ

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim myPath As String
If Target.Cells(1, 1).Column <> 10 Then Exit Sub
Cancel = True
myPath = ThisWorkbook.Path & "\" & Target.Text & "*"
If Dir(myPath, vbDirectory) <> "" Then
myPath = ThisWorkbook.Path & "\" & Dir(myPath, vbDirectory)
Shell "explorer.exe /e,/root," & myPath, vbNormalFocus
Exit Sub
End If
myPath = Replace(LCase(myPath), ".jpg*", "\" & Left(Target.Text, Len(Target.Text) - 4) & "*.jpg")
If Dir(myPath, vbNormal) <> "" Then
myPath = Replace(LCase(myPath), "*.jpg", Dir(myPath, vbNormal))
Shell "rundll32.exe shimgvw.dll,ImageView_Fullscreen " & myPath, vbNormalFocus
End If
End Sub

参考まで
    • good
    • 0

Dir関数にワイルドカード「*」を指定して下さい。


パスは固定ならそのまま指定すればいいし
何か規則性があるなら条件切ればいいし
あらかじめシートに別フォルダのパスを入力させておいてもいいし
毎回毎回選ばせたいなら選ばせればいいと思います
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!