エクセルVBAで大量の画像をまとめてシートに貼り付けるAddPictureメソッドの使い方

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

大量の画像を、エクセルシートに、画像サイズと位置を揃えて貼り付けていく…そんな作業をしたことはありますか？

ただ貼り付けるだけならまだしも、画像はすべて横位置を揃えて！という指定があったり、フォルダにある画像のサイズはばらばらなのに、エクセルに貼り付けるときはすべて同じサイズに！なんて指定があったり…。

はっきり言って苦行ですよね。

そんな面倒なことはVBAに任せましょう！

ということで、今回はShapesコレクションのAddPictureメソッドとFileSystemオブジェクト使って、フォルダにある画像ファイルを、位置やサイズを指定して、一括で貼り付ける方法をご紹介します！

画像をまとめて貼り付けるメリット
フォルダの画像を一括で貼り付けるマクロ
フォルダに画像以外のファイルがあるとどうなるのか
まとめ
連載目次：エクセルVBAで図形を操作するShapeオブジェクトの使い方

画像をまとめて貼り付けるメリット

例えばこちらのフォルダにある画像を…

こんな風に、ワンクリックでエクセルシートへ貼り付けることができます。

前回の記事でご紹介したように、AddPictureメソッドのパラメータで貼り付ける画像のサイズや位置も指定ができるので、縦又は横に向かって一定の間隔を空けて画像を貼り付けていくことができるのです。

こんな感じで。

この方法なら画像の横位置も縦位置も、画像のサイズも指定の通りに揃えられるので、人間が手動で貼り付けていくより遥かに早く、正確です。

そして何より、楽です。

フォルダの画像を一括で貼り付けるマクロ

フォルダにある画像を全てエクセルシートに貼り付けるためのVBAコードがこちら。

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

FileSystemオブジェクトとFor Each~Nextを使って、エクセルと同じ階層にある『images』というフォルダにある画像ファイルを全て、順番にエクセルシートの下方向に向かって貼り付けていくコードです。

FileSystemオブジェクトとFor Each～Next文については下記記事で紹介されていますので、併せてご覧ください。