Excel に画像を貼り付けると、大きすぎたり位置がズレたりして整えるのが大変… という経験はありませんか？ 特に、名簿の写真・商品画像・検査画像などをセルに合わせて貼りたい場合、手作業ではとても面倒です。
そこで今回は、ExcelVBA で画像をセルに自動配置するマクロ をご紹介します。
- セルにぴったり収まるように縮小
- 縦横比を保ったまま調整
- セルの中央にきれいに配置
- 複数画像をまとめて自動貼付
画像データの置き場所について
今回はCドライブ直下に「Images」というフォルダに画像データを保存しており、このフォルダを指定するようにコードを作成しております。
任意のフォルダを指定したい場合はコードを変更してください。
※コードを変更することにより、任意のフォルダを指定できます。
今回のシート構成（シート名：画像貼付）
次のように、画像を貼りたいファイル名をセルを A 列に入力します。
シート名は「画像貼付」としてください。
画像は、フォルダ内に格納された JPG / PNG / GIF などに対応しています。
画像をセルにきれいに自動配置するマクロ（コピペOK）
以下のコードを 標準モジュール に貼り付けて使います。
Option Explicit
Sub InsertImagesToCells()
Dim ws As Worksheet
Dim lastRow As Long
Dim imgPath As String
Dim folderPath As String
Dim i As Long
Dim pic As Picture
Dim cell As Range
Dim ratio As Double
' ★画像フォルダのパス（必要に応じて変更）
folderPath = "C:\Images\" ' ←最後の \ を忘れない
Set ws = Worksheets("画像貼付") ' シート名は変更可能
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' ★サムネイルとして表示したいサイズ（ポイント単位）
' 数字を大きくすると画像も大きくなります
Const ThumbWidth As Double = 200
Const ThumbHeight As Double = 200
For i = 2 To lastRow
imgPath = folderPath & ws.Cells(i, 1).Value
Set cell = ws.Cells(i, 2)
If Dir(imgPath) <> "" Then
' 既存の画像があれば削除（同じセルに何度も貼らないように）
DeletePicturesInCell cell
' 画像を挿入
Set pic = ws.Pictures.Insert(imgPath)
' ★縦横比を保ったまま「サムネイルサイズ」に合わせて縮小
ratio = Application.Min(ThumbWidth / pic.Width, ThumbHeight / pic.Height)
' 必要なら、あまりに小さくなり過ぎないように下限を決めてもOK
' If ratio > 1 Then ratio = 1 ' 拡大はしたくない場合
pic.Width = pic.Width * ratio
pic.Height = pic.Height * ratio
' ★セルより画像の方が大きい場合は、セルも少し広げてあげる（お好み）
If cell.Width < pic.Width Then
cell.ColumnWidth = cell.ColumnWidth * (pic.Width / cell.Width)
End If
If cell.RowHeight < pic.Height Then
cell.RowHeight = pic.Height + 4
End If
' セルの中央に配置
pic.Left = cell.Left + (cell.Width - pic.Width) / 2
pic.Top = cell.Top + (cell.Height - pic.Height) / 2
Else
ws.Cells(i, 2).Value = "画像なし"
End If
Next i
MsgBox "画像の貼り付けが完了しました！", vbInformation
End Sub
' 指定セルの範囲内にある画像だけ削除する（貼り直し用）
Private Sub DeletePicturesInCell(ByVal targetCell As Range)
Dim shp As Shape
Dim ws As Worksheet
Set ws = targetCell.Worksheet
For Each shp In ws.Shapes
If shp.Type = msoPicture Then
If shp.Top >= targetCell.Top _
And shp.Top < targetCell.Offset(1, 0).Top _
And shp.Left >= targetCell.Left _
And shp.Left < targetCell.Offset(0, 1).Left Then
shp.Delete
End If
End If
Next shp
End Sub
コード解説（初心者向け）
① セルではなく「サムネイルサイズ」を基準に縮小
画像をセルに合わせるのではなく、 見やすい固定サイズ（200×200）で画像を整えるため、 小さくなりすぎる問題がなくなります。
② セルの側を画像に合わせて適度に拡張
cell.ColumnWidth = cell.ColumnWidth * (pic.Width / cell.Width)画像のほうが大きい場合は、セル幅・行高さを自動調整します。
③ 画像をセル中央に配置してきれいに整列
pic.Left = cell.Left + (cell.Width - pic.Width) / 2応用：もっと大きく表示したい場合
以下の数値を変えるだけで、画像サイズを自由に調整できます。
Const ThumbWidth As Double = 150
Const ThumbHeight As Double = 150
まとめ：画像一覧の作成が驚くほど簡単に
今回のマクロを使えば、
- 画像の縮小サイズが極端に小さくなる問題が解決
- 見やすいサムネイルサイズで一覧化できる
- セルにきれいに中央配置される
- たくさんの画像でも一括処理できる
写真付き名簿、商品カタログ、検査画像一覧など、幅広い用途に活用できます。 カスタマイズ版（枠線追加・セル自動拡大など）も作成できますので、お気軽にご相談ください。
コメント