【エクセルVBA】FileDialogプロパティで任意のフォルダの画像をまとめてシートに貼り付ける方法

皆様こんにちは、ノグチです。

前回は、ShapesコレクションのAddPictureメソッドとFileSystemオブジェクトを使って、フォルダにある画像ファイルを一括でシートに貼り付ける方法をご紹介しました。

しかし前回ご紹介したコードでは、コードの中に操作対象のフォルダパスが直接書き込まれていましたから、他のフォルダ構成になってしまうと、このコードは使えなくなってしまいます…

ならば折角のコードがその場限りになってしまわないよう、汎用化してしまおう！

ということで、今回はFileDialogプロパティで、任意フォルダの画像をシートにまとめて貼り付ける方法をご紹介します！

コードの使いまわしができるようにすることのメリット
前回のおさらいと見直すコードの例
ダイアログで任意のフォルダを指定する方法
まとめ

コードの使いまわしができるようにすることのメリット

まず、汎用化と言っても特に難しいことをするわけではありません。

作ったコードを、他の対象ファイルであったり、フォルダ階層であったりした場合にも使えるように、コードを見直して『使いまわし』ができるようにするだけです。

汎用化をすることによって、ぱっと思い浮かぶメリットとしてはこちら。

フォルダやファイル名が変わっても、コードを修正することなくツールを利用できる
修正が必要になった場合、影響範囲が分かりやすい
コードが短文になることが多く、読みやすい
他のツールにもコードを使いまわしやすい

他にもメリットはありますが、こんなところでしょうか。

前回のおさらいと見直すコードの例

では、前回の記事で使用したコードのフォルダ指定部分を、FileDialogプロパティを使って汎用化していきましょう。

前回のコードはこちら。

Sub 画像貼り付け()
Dim lngTop As Long
Dim objFile As Object
Dim objFldr As FileSystemObject
 
    Set objFldr = CreateObject("Scripting.FileSystemObject")
 
    lngTop = 20
    
    For Each objFile In objFldr.GetFolder(ThisWorkbook.Path & "\images").Files
        ActiveSheet.Shapes.AddPicture _
                Filename:=objFile, _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=20, _
                Top:=lngTop, _
                Width:=300, _
                Height:=200
        
        lngTop = lngTop + 200 + 20
    
    Next
 
End Sub

エクセルブックと同じ階層にある、「images」フォルダに格納されているファイルを、順番にシートに貼り付けるという内容のコードでした。

画像ファイルをシートに貼り付けるという動作は問題ないのですが、このままでは画像を格納したフォルダの名前や階層が限られてしまいます。

FileDialogプロパティで任意のフォルダを操作対象にしてしまいます。

ダイアログで任意のフォルダを指定する方法

FileDialogプロパティでフォルダ選択ダイアログを表示させる

ここで使うのは、ApplicationオブジェクトのFileDialogプロパティです。

FileDialogという名前の響きから、ファイルしか選べないのでは？とお思いでしょうか。

ご安心あれ、FileDialogプロパティのパラメーターにmsoFileDialogFilePickerをセットすれば、ちゃんとフォルダも選択できるのです。

このFileDialogプロパティについては下記記事で説明されていますので、併せてご覧ください。

エクセルVBAでFileDialogオブジェクトを使ってファイル選択ダイアログを開く

エクセルVBAでファイルを開く作業を自動化する方法についてシリーズでお伝えしています。今回は、エクセルVBAでFileDialogオブジェクトを使ってファイル選択ダイアログを表示させる方法です。

Showメソッドでフォルダ選択ダイアログを表示させる

まずはFileDialogオブジェクトのShowメソッドで、フォルダ選択のダイアログを表示させるようにします。

Application.FileDialog(msoFileDialogFolderPicker).Show

すると、こんなダイアログが表示されるようになります。

用意した変数に取得したフォルダパスをセットする

次にApplicationオブジェクトのFileDialogプロパティを使って、FileDialogオブジェクトを取得しましょう。

FileDialogオブジェクトで取得したフォルダパスを格納するための変数を宣言しておいて…

Dim strPath as String

FileDialogオブジェクトのSelectedItemsプロパティには、ユーザーがフォルダ選択のダイアログで選択したフォルダパスが格納されているので、これを定義しておいた変数にセットします。

StrPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

コード内のフォルダパス部分を変数に置き換える

ついでに、Withを使って、コードをくくってしまいましょう。

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        StrPath = .SelectedItems(1)
    End With

あとはこの変数を、For Each ~.GetFolder().Filesの()内と置き換えるだけ。

するとこんなコードになります。

Sub シェイプ貼り付け()
Dim lngTop As Long
Dim objFile As Object
Dim objFldr As FileSystemObject
Dim StrPath As String

    Set objFldr = CreateObject("Scripting.FileSystemObject")
    lngTop = 20
  
    With Application.FileDialog(msoFileDialogFolderPicker)
         .Show
         StrPath = .SelectedItems(1)
    End With
    
    For Each objFile In objFldr.GetFolder(StrPath).Files
            ActiveSheet.Shapes.AddPicture _
                    Filename:=objFile, _
                    LinkToFile:=False, _
                    SaveWithDocument:=True, _
                    Left:=20, _
                    Top:=lngTop, _
                    Width:=150, _
                    Height:=100
            
            lngTop = lngTop + 100 + 10
    Next

End Sub

これで、ユーザーが任意に選択したフォルダ内の画像を、シートにまとめて貼り付けることができるようになりました。

これなら画像ファイルの名前を変更したり、フォルダの階層を変更する必要もありません。