【EXCEL VBA】結合したセルの大きさに合わせて写真を挿入するコード

このページで紹介する内容
1. エクセルデータのダウンロードリンク
2. セルに合わせた大きさの写真を挿入するマクロ
コードの紹介
写真をセルの大きさにぴったり合わせたい場合
補足（VBAの入力の仕方）
1. １．開発タブの有効化
2. ２．コードを貼り付ける
まとめ
筆者おすすめ健康食品

このページで紹介する内容

　このページのコードを使うと、上の写真のように、エクセルの結合セルの大きさに合わせて写真をきれいに貼り付けることができます。

　挿入したいセルをダブルクリックすると、写真選択のウィンドウが自動的に開いてくれて、写真の縦横比を保ったまま、セルの大きさに自動的に合わせて、セルの中央に配置してくれます。

＜メリット＞
エクセルに、写真を張り付けて、大きさを調整する作業の負担を軽減してくれます。

＜注意点＞
エクセルの「開発」タブを有効化し、VBAのコードを貼り付ける作業が必要です。

エクセルデータのダウンロードリンク

とにかく使えれば良い！という方に向けて、筆者が作成したエクセルデータのダウンロードリンクをこちらでご紹介いたします。

セルに合わせた大きさの写真を挿入するマクロ

1 ファイル 25.95 KB

ダウンロード

コードの紹介

VBAの任意のシートに、以下のコードを貼り付ければ完了です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim myF As Variant
Cancel = True

'================写真を貼り付けたい範囲の調整をここで行う。横23×縦19のセルを結合した場合はこのままです。
If Not Target.Columns.Count = 23 And Target.Rows.Count = 19 Then Exit Sub
'================上の23と19を好みのセルの結合した大きさに変えてください。

myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF <> False Then
With ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=-1, Height:=-1)
'===============タテヨコの縮尺を保持して拡大または縮小
.LockAspectRatio = True '縦横比率の維持（念のため）
.Width = Target.Width
If .Height > Target.Height Then .Height = Target.Height

'===============中央へ調整
.Top = Target.Top + Target.Height / 2 - .Height / 2
.Left = Target.Left + Target.Width / 2 - .Width / 2

End With
End If
End Sub

結合セル以外でダブルクリックした時には反応しないようにしています。

正確には、結合セルの大きさを指定して、指定した結合セル以外ではダブルクリックしても反応しないようにコードを書いています。

下の画像のように、横２３×縦１９のセルを結合した部分をダブルクリックすると反応するようにコードを書いています。

Target.Columns.Count = 23 And Target.Rows.Count = 19　の23と19を好きな数字で書き換えれば、自分好みの写真整理シートができます。

写真をセルの大きさにぴったり合わせたい場合

写真の縦横比を変えて、結合したセルにぴったりと写真の大きさを合わせる場合は、次のコードを使用します。「ここから」「ここまで」と記載された部分が上のコードと違います。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim myF As Variant
Cancel = True

'================写真を貼り付けたい範囲の調整をここで行う。横23×縦19のセルを結合した場合はこのままです。
If Not Target.Columns.Count = 23 And Target.Rows.Count = 19 Then Exit Sub
'================上の23と19を好みのセルの結合した大きさに変えてください。

myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF <> False Then
With ActiveSheet.Shapes.AddPicture(Filename:=myF, LinkToFile:=False, _
SaveWithDocument:=True, Left:=Target.Left, Top:=Target.Top, _
Width:=-1, Height:=-1)
'==================ここから===========================================
.LockAspectRatio = False '縦横比率を維持しない
.Width = Target.Width
.Height = Target.Height
'==================ここまで===========================================

'===============中央へ調整
.Top = Target.Top + Target.Height / 2 - .Height / 2
.Left = Target.Left + Target.Width / 2 - .Width / 2

End With
End If
End Sub