[[20100722153421]]　『エクセルファイルとは別フォルダに写真を保存しています。J列のあるセル(フォルダまたはファイル名記入)をダブルクリックすると、記入名称に該当するフォルダまたはファイルが開くようにするには、どのように改良すればよろしいでしょうか？　ページの最後に飛ぶ

『エクセルファイルとは別フォルダに写真を保存しています。J列のあるセル(フォルダまたはファイル名記入)をダブルクリックすると、記入名称に該当するフォルダまたはファイルが開くようにするには、どのように改良すればよろしいでしょうか？
下記マクロでは、エクセルと写真フォルダが同フォルダにある場合、正常に動作します。しかし、エクセルファイルと写真フォルダは別フォルダの場合、動作しません。
よろしくお願い致します。

Excel2003で作成しました。

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』

（yorosiku）

 どこにあるかわからないファイルって事ですよね？
 ファイル検索してしまうようにコードを追加編集してみましたので試してみてください。

 シートモジュールに

  Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim myPath As String
  If Target.Column <> 10 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  Cancel = True
  myPath = Target.Value
  If StrConv(myPath, vbNarrow + vbLowerCase) Like "*.jpg" Then
    If myPath Like "?:\*" = False And myPath Like "\\*" = False Then
      myPath = FindFile(myPath)
    End If
    If Dir(myPath, vbNormal) <> "" Then
      Shell "rundll32.exe shimgvw.dll,ImageView_Fullscreen " & myPath, vbNormalFocus
    End If
  Else
    If Dir(myPath, vbDirectory) <> "" Then
      Shell "explorer.exe /e,/root," & myPath, vbNormalFocus
    End If
  End If
  End Sub

 標準モジュールに

  Private Declare Function SearchTreeForFile Lib "imagehlp.dll" _
      (ByVal RootPath As String, _
       ByVal InputPathName As String, _
       ByVal OutputPathBuffer As String) As Long

  Function FindFile(FindFileName As String) As String
  Dim myFolder As Object
  Dim myRootPath As String, myFind As String, myBook As String * 513
  With CreateObject("Scripting.FileSystemObject")
    For Each myFolder In .Drives
      If myFolder.DriveType = 2 Then
        myRootPath = myFolder.Path & "\"
        myFind = FindFileName
        If SearchTreeForFile(myRootPath, FindFileName, myBook) Then
          myFind = Left$(myBook, InStr(myBook, vbNullChar) - 1)
          FindFile = myFind
          Exit Function
        End If
      End If
    Next myFolder
  End With
  End Function

 （ｍｏｍｏ）

説明不足で申し訳御座いません。
教えて頂いたマクロで試験しましたが、うまく動作しませんでした。

商品の写真ファイルとエクセルファイルは、下記のフォルダに保存しています。

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

D<マイドキュメント＜事務書類＜商品一覧表.xls

よろしくお願い致します。

（yorosiku）

 うまく動作しないというのは、どのような結果になったのでしょう？

 セルの中には具体的にどのような文字列が入っていますか？
 （ｍｏｍｏ）

全く動作しませんでした。
他でも質問していた為、質問終了とさせて頂きます。
申し訳御座いません。
（yorosiku）

 [はじめての方へ：詳細版　マルチポストについて]
 [マルチポストで書き込んだ方]は他の掲示板で解決した内容をこのボードでも公開して、 
 書き込みが将来人の役に立つように協力してください
 （dack）

コメント返信：

[ 一覧(最新更新順) ]