Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Home Premium : Excel 2010)
現ファイルのフォルダを表示
投稿日時: 20/02/16 20:17:59
投稿者: shimoichimabu

同一フォルダに本ブックと画像ファイルが入っているフォルダが多くあります。
この画像フォルダのファイル名を本プログラムで適宜変更しています。
下記はそのファイル名を変更する前段階のコードです。
しかし、BrowseForFolderではかなり上の階層のツリーが表示されます。
これを、現ブックの存在するフォルダ内を一発で表示したいです。
ChDir ThisWorkbook.Pathではうまくいきません。
本プログラムを実行するたびに、上の階層のフォルダを順次開いて
該当するフォルダを選択しています。とても煩雑です。
何かいい方法が無いでしようか?
「名前を付けて保存」コマンドの場合、現ブックのフォルダが一発で開いていますが・・・・。
↑このコマンドからPathが取得できても、Dialog画面に「名前を付けて保存」が
表示されるので、ちょっと使えません。
 
Private Sub ファイル名修正Button_Click()
 
Dim ダイアログ表示 As Object, フォルダ名 As String, buf As String, msg As String
 
On Error Resume Next
    ChDrive ThisWorkbook.Path
    ChDir ThisWorkbook.Path
On Error GoTo 0
 
Set ダイアログ表示 = CreateObject("Shell.Application").BrowseForFolder(0, "画像ファイルが保存されているフォルダを指定して下さい。", 0) ← ここでフォルダを一発で表示させる
 
・・・・・・・・・・・・・・・・・・・・
・・・・・・・・・・・・・・・・・・・・

回答
投稿日時: 20/02/16 20:36:20
投稿者: WinArrow
投稿者のウェブサイトに移動

エラートラップは外しておきましょう。
 
フォルダの内容(ファイル一覧)をダイアログに表示させるメソッド
 
Application.GetOpenFilenamemeメソッドを使うと簡単です。
 
使い方は、HELPを参照してください。
 
複数のファイル名を1回に操作で取得できます。
 

回答
投稿日時: 20/02/16 21:13:44
投稿者: ロードランナー
投稿者のウェブサイトに移動

>現ブックの存在するフォルダ内を一発で表示したい
同じ悩みの方はいらっしゃるものですね。
 
表示中(アクティブ)のブックが、どのフォルダにあるかを、エクスプローラで表示するものです。
個人用マクロブックに入れて活用しています。
 
いずれも標準モジュールに作り、SBRCMAdd()をブックオープンで走らせます。
(ここのコードは分かりますよね?)
 
Sub SBRCMAdd()
    With Application.CommandBars("Ply")
        .Reset 'シートタブメニューのリセット
        With .Controls.Add _
            (Before:=1, _
            Type:=MsoControlType.msoControlButton)
            .Caption = "このブックのフォルダを開く"
            .OnAction = "ExpOpen"
            .BeginGroup = True
        End With
    End With
End Sub
 
Sub ExpOpen()
    If ActiveWorkbook.Path <> "" Then
        'MsgBox "エクスプローラを開きます"
        On Error Resume Next
        Shell "C:\Windows\Explorer.exe " & ActiveWorkbook.Path, vbNormalFocus
        On Error GoTo 0
    Else
        MsgBox "このブックは未だ保存されていません"
    End If
End Sub
 
BeforeClose でResetしておいたほうが安心です。

回答
投稿日時: 20/02/16 21:15:20
投稿者: ロードランナー
投稿者のウェブサイトに移動

アッと忘れてしまいました。使い方は、シート見出しで右クリックです。

回答
投稿日時: 20/02/16 22:51:12
投稿者: WinArrow
投稿者のウェブサイトに移動

メソッドの記述ミスがありましたので、サンプルコードを掲示します。
 
Sub tes()
Dim Filenames, File
    ChDrive "C"
    ChDir ThisWorkbook.Path
    Filenames = Application.GetOpenFilename(filefilter:="画像*,*.jpg", MultiSelect:=True)
    For Each File In Filenames
        '個々のアイルの操作
    Next
End Sub

回答
投稿日時: 20/02/16 23:25:27
投稿者: simple

BrowseForFolderの第4引数に、RootFolderを指定できます。
その指定フォルダが最上位に表示され、それ以下のフォルダが表示されます。
注意点は、最後に"\"をつけることです。
つまり、第4引数に、ThisWorkbook.Path & "\" を追加すればよいと思います。

回答
投稿日時: 20/02/16 23:38:26
投稿者: takesi

Application.GetOpenFilenameとちがう別案
(私が好きな方法です。)
 
エクスプローラの選択画面が表示されると毎回先頭から表示され、
スクロールした先で選択を繰り返すのがめんどくさい 時に楽できます。
 
下記参考にユーザーフォーム作ると、
エクスプローラからファイルをドラッグ&ドロップするだけでアイテムのPas取得できます。
 
http://excel.syogyoumujou.com/memorandum/d_and_d_1.html
ListViewコントロールを利用したドラッグ&ドロップ

投稿日時: 20/02/17 21:34:41
投稿者: shimoichimabu

WinArrowさん、ロードランナーさん、simpleさん、takesiさん回答ありがとうございます。
 
エクスプローラで表示する方法、Application.GetOpenFilename、ListViewコントロールなど
貴重な情報ありがとうございました。現在、勉強中です。
 
>BrowseForFolderの第4引数に、RootFolderを指定できます。
>注意点は、最後に"\"をつけることです。
"\"を付けなくてもエラーが発生せず、うまく動作しました。
なお、付けても問題なく、動作しました。
CreateObject("Shell.Application").BrowseForFolder(0, "画像ファイルが保存されているフォルダを指定して下さい。", 0,ThisWorkbook.Path)
simpleさんとはEXCELのVer.が違うから?

回答
投稿日時: 20/02/17 21:46:45
投稿者: simple

なるほど。ネット上の記事をそのまま信用しただけです。
試すと、たしかに\はなくても動作しますね。(当方 Win7,Excel2010)
これで、解決ですかね。良かったです。

投稿日時: 20/02/17 22:48:24
投稿者: shimoichimabu

simpleさん、回答ありがとうございます。
 
このたびは、色々勉強させてもらいました。