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

画像ファイルの画像をExcelに挿入、指定したセルに合わせたサイズに変更して貼り付けるサンプルプログラムを覚え書き。

応用例として複数ある画像ファイルをタイル状に指定セルに貼り付けるサンプルプログラムも作成しました。

画像ファイルの画像を挿入する基本的なサンプルプログラム
1. サンプルプログラムその1
2. サンプルプログラムその2
セルのサイズに合わせて画像のサイズを変更する
複数画像をセルに合わせてタイル状に貼り付ける
まとめ

画像ファイルの画像を挿入する基本的なサンプルプログラム

まずは、画像ファイルを指定して画像をExcelに挿入するだけの基本的なサンプルプログラムを記載します。

Excelのシートに画像ファイルの画像を挿入する場合は、shapes.addpicture メソッドを使います。

サンプルプログラムその1

以下のサンプルプログラムは、c:\temp フォルダに保存されている画像ファイル"image01.jpg"をシートの左隅に挿入する例です。

Sub sample01()
Dim objShape As Object

Set objShape = ActiveSheet.Shapes.AddPicture( _
                Filename:="c:¥temp¥image01.jpg", _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=1, _
                Top:=1, _
                Width:=150, _
                Height:=150)
End Sub

プログラム6行目の LinkToFile 引数に True を指定すると画像のリンク貼り付けとなります。

リンク貼り付けした場合は、元の画像の保存場所が変わったり、削除された場合表示されなくなるので注意してください。

shapes.addpicture メソッドで指定できる各引数についての詳細は、以下のドキュメントを参照してください。

shapes.addpicture メソッドの詳細(ヘルプ)は以下を参照して下さい

Shapes.AddPicture メソッド (Excel)

Office VBA リファレンストピック

サンプルプログラムその2

サンプルプログラムその1では、画像サイズ(Width、Height)を指定していますが、元の画像サイズで挿入したい場合は、ScaleWidth、ScaleHeight に100%(1.0)を指定します。

ScaleWidth、ScaleHeight メソッドの詳細は、以下のドキュメントを参照してください。

ShapeRange.ScaleWidth メソッド (Excel)

Office VBA リファレンストピック

Sub sample02()
Dim objShape As Object

Set objShape = ActiveSheet.Shapes.AddPicture( _
                Filename:="c:¥temp¥image01.jpg", _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=1, _
                Top:=1, _
                Width:=0, _
                Height:=0)
    
    With objShape
        .ScaleWidth 1#, msoTrue
        .ScaleHeight 1#, msoTrue
    End With
    
End Sub

セルのサイズに合わせて画像のサイズを変更する

次にセルのサイズに合わせて画像をリサイズした上でアクティブセルに挿入するサンプルプログラムを以下に記載します。

Sub sample03()
Dim objShape As Object


Set objShape = ActiveSheet.Shapes.AddPicture( _
                Filename:="c:¥temp¥image01.jpg", _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=ActiveCell.Left, _
                Top:=ActiveCell.Top, _
                Width:=ActiveCell.Width, _
                Height:=ActiveCell.Height)
       
End Sub

shapes.addpicture メソッドの位置とサイズを表す引数(Top、Left、Widht、Height)にActivecell.Top(Left/Width/Hight)を指定するだけでセルのサイズに合わせて画像がリサイズされます。

複数画像をセルに合わせてタイル状に貼り付ける

最後に応用編として、複数の画像ファイルを指定したセルにセルのサイズに合わせてリサイズした上で貼り付けていくサンプルプログラムを作ります。

前提条件

c:\temp フォルダに image01.jpg ～ image20.jpg ファイルが保存されており、以下のようなExcelのシートの表に画像を貼り付けていきます。

画像ファイルの拡張子(.jpg)を除いた文字列が入力されているセルの右隣のセルにサイズを合わせて画像を貼り付けていきます。

最終的な結果として、以下のようになるプログラムを作ります。

作成するプログラムの考え方

作成するプログラムの処理ロジックを簡単に説明するとこんな感じです。

dir関数とDo Until ループを組み合わせてフォルダ内の画像ファイル名を順次取得
ファイル名から拡張子を除いた文字列が入力されているセルを Cells.Find で探し、見つかったらそのセルの右隣のセルをアクティブにする。
アクティブセルに画像ファイルをセルのサイズに合わせてリサイズして貼り付ける

サンプルプログラム

実際のサンプルプログラムを以下に記載します。

Sub sample04()
Dim objShape As Object
Dim strPath As String, strFileName As String
Dim strImgName As String

strPath = "c:¥temp¥"
strFileName = Dir(strPath & "*.jpg")

    Do Until Len(strFileName) = 0
        strImgName = Left(strFileName, Len(strFileName) - 4)
        
        Cells.Find(What:=strImgName).Activate
            ActiveCell.Offset(0, 1).Activate
    
        Set objShape = ActiveSheet.Shapes.AddPicture( _
                        Filename:=strPath & strFileName, _
                        LinkToFile:=False, _
                        SaveWithDocument:=True, _
                        Left:=ActiveCell.Left, _
                        Top:=ActiveCell.Top, _
                        Width:=ActiveCell.Width, _
                        Height:=ActiveCell.Height)
        
        strFileName = Dir()
    Loop

End Sub

注意点

セルのサイズの縦横比と画像の縦横比が合っていないと画像の縦横比が変わってしまい、画像が崩れてしまうので注意してください。

まとめ

画像ファイルの画像をExcelにシートに挿入する基本的なサンプルプログラムとそれを応用して複数の画像ファイルの画像をセルのサイズに合わせてタイル状に貼り付けていくサンプルプログラムを記載しました。

参考になれば幸いです。