Excel VBA:複数の画像ファイルを一括でExcelに挿入、指定したセルに移動、サイズ変更するサンプルプログラム

フォルダに保管されている複数の画像ファイルを一括してExcelに挿入、貼付けしたあとに各画像を指定したセルに移動、セルのサイズに合わせて画像のサイズを変更するサンプルプログラムを作ったので覚書。

はじめに

以降で紹介するサンプルプログラムは、画像がリンク貼り付けされます。

元の画像を移動や削除してしまうとExcel上で表示できなくなるので注意してください。

もし画像をリンク貼り付けではなく、普通に貼り付けたい場合は shapes.addpicture メソッドを使用してください。

以下の記事で shapes.addpicture メソッドを使用したサンプルプログラムを紹介していますので、そちらを参照してください。

Excel VBA:画像ファイルの画像を指定したセルのサイズを合わせて貼り付けるサンプルプログラム

画像ファイルの画像をExcelに挿入、指定したセルに合わせたサイズに変更して貼り付けるサンプルプログラムを覚え書き。 応用例として複数ある画像ファイルをタイル状に指定セルに貼り付けるサンプルプログラムも作成しました。

selifelog.com

2019.02.22

フォルダに保存されている複数の画像ファイルをExcelに挿入するサンプルプログラム

まずは、フォルダに保管されている複数の画像ファイルの画像をオブジェクトととして一括してExcelにはりつけるVBAのサンプルプログラムを紹介します。

画像のサイズや場所は指定していないので、各画像オブジェクトが重なる形でExcelに貼り付きます。

Sub Sample1()
Dim strFileName As String, dirPath As String

dirPath = "c:¥temp¥"
strFileName = Dir(dirPath & "*.JPG")

    Do Until strFileName = ""
        ActiveSheet.Pictures.Insert(dirPath & strFileName).Select
        Selection.Name = strFileName
        strFileName = Dir()
    Loop

End Sub

サンプルプログラムの補足

サンプルプログラムの5行目でDir関数を使用してC:\tempフォルダに保存されているJPGファイルのファイル名を1つ1つ取り出し、そのファイル名を使用して8行目の"ActiveSheet.Pictures.Insert"でExcelに画像ファイルの画像をオブジェクトととして貼り付けています。

画像ファイルの種類がJPG以外のファイルであればその拡張子に修正してください。

フォルダ内のすべてのファイルを対象とするのであれば、".JPG"を".*"に修正すればよいです。

"ActiveSheet.Pictures.Insert"でExcelに画像ファイルを挿入したあとに挿入された画像オブジェクトにファイル名と同じ名前をつけています。(9行目)

フォルダ内の複数画像を一括でExcelに挿入、セルのサイズに合わせて画像サイズを変更、移動するサンプルプログラム

本題に入る前に、オブジェクト(シェイプ)の移動やサイズ変更に関する基本的なサンプルプログラムを以下の記事にまとめてあります。

この記事のサンプルプログラムを見る前にこちらの記事を参照しておいていただけるとわかりやすいかもしれません。

Excel VBA:セルに合わせて図形/画像オブジェクト(シェイプ)を移動する、セルと同じサイズに変更するサンプルプログラム

Excelに貼り付いている図形/画像オブジェクト(シェイプ)をセルに合わせて位置を移動したり、セルと同じ大きさにサイズ変更するサンプルプログラムを覚え書き。

selifelog.com

2018.07.05

フォルダに保存されているすべての画像ファイルをExcelに挿入して、挿入された画像をセルに合わせてサイズ変更、移動して配置するサンプルプログラムを紹介します。

以下のようにC:\TEMPフォルダに複数の画像が保存されています。

フォルダ内の画像をExcelに一括で挿入し、以下のような表に画像サイズを変更、移動させていきます。

画像それぞれの左セルにはその画像のファイル名(フルパス)を入力します。

以下サンプルプログラムです。

Sub Sample6()
Dim strFileName As String, dirPath As String
Dim Obj As Object

Range("B2").Activate

dirPath = "c:¥temp¥"
strFileName = Dir(dirPath & "*.JPG")

    Do Until strFileName = ""
        ActiveSheet.Pictures.Insert(dirPath & strFileName).Select
        Selection.Name = strFileName
        
        ActiveSheet.Shapes(strFileName).LockAspectRatio = msoFalse
       
        With Selection     
            .ShapeRange.Top = ActiveCell.Top
            .ShapeRange.Left = ActiveCell.Left
            
            .Width = ActiveCell.Width
            .Height = ActiveCell.Height
        End With
                
        ActiveCell.Offset(0, -1).Value = dirPath & strFileName
        
        ActiveCell.Offset(1, 0).Activate
        strFileName = Dir()
    
    Loop

End Sub

サンプルプログラムを実行すると以下のような結果になります。

画像の縦横比率を無視してセルのサイズに合わせているため、画像によってはだいぶ変形してしまいます。

次に上記のサンプルプログラムと実行結果は同じですが、処理の順番を変えたサンプルプログラムを参考までに記載しておきます。

以下のサンプルプログラムは、一旦すべての画像をExcelに挿入後、"For Each"ステートメントを使用して挿入された画像1つ1つを順番にセルに貼り付けています。

Sub Sample7()
Dim strFileName As String, dirPath As String
Dim Obj As Object

Range("A2").Activate

dirPath = "c:¥temp¥"
strFileName = Dir(dirPath & "*.JPG")

    Do Until strFileName = ""
        ActiveSheet.Pictures.Insert(dirPath & strFileName).Select
        Selection.Name = strFileName
        
        ActiveCell.Value = dirPath & strFileName
        ActiveCell.Offset(1, 0).Activate
        
        strFileName = Dir()
    Loop

Range("B2").Activate
    For Each Obj In ActiveSheet.Shapes
        Obj.Select
        Obj.LockAspectRatio = msoFalse
        
        Selection.ShapeRange.Top = ActiveCell.Top
        Selection.ShapeRange.Left = ActiveCell.Left
        
        Obj.Width = ActiveCell.Width
        Obj.Height = ActiveCell.Height
        
        ActiveCell.Offset(1, 0).Activate
    Next Obj

End Sub

まとめ

画像ファイルをExcelに挿入する際には、"ActiveSheet.Pictures.Insert"を使用します。

また、セルに合わせて移動するには、"ShapeRange.Top"と"ShapeRange.Left"を使います。

サイズを変更する際には、縦横の比率を維持/無視するかを決めて、"LockAspectRatio"プロパティで指定してください。