2025.04.23

EXCELでセルに画像をリサイズして貼り付けする

ひとみBBA

ExcelでVBA を使用して、セルに画像をリサイズして貼り付ける方法になります。

本当は、画像をドラックして貼り付けたかったんですが、EXCELにはその機能がないようです。
なので、セルをダブルクリックしたら、画像のダイアログを表示して画像を挿入する方法になります。

ひとみBBA

実際に使っている手順をそのまま載せるよ。
設定の詳細は別のサイトで検索してね☆彡

VABを使用する場合に「開発リボン」の有効化が必要です。
ファイル＞その他＞オプションで「開発」にチェックを入れます。
画像付きでの方法は以下を参照してください。

「開発リボン」の有効化

EXCELでVBAを使用できるようにする方法

EXCELでセルに画像をリサイズして貼り付けする

１．①をダブルクリックしたら画像を表示するような、表を作成します。

２．Alt + F11 キーまはた「開発」の「コードの表示」をクリックしVBAを表示します。

左側で今回使用するシートを選択します。右の赤枠「Worksheet」を選択します。

３．右の赤枠「BeforeDoubleClick」を選択します。

４．「Private Sub Worksheet_BeforeDoubleClick」から「End Sub」の間に青枠のコードを挿入します。

Dim fd As FileDialog
Dim selectedFile As String
Dim img As Picture
Dim cellLeft As Double, cellTop As Double, cellWidth As Double, cellHeight As Double

' ダブルクリックされたセルの範囲を取得
cellLeft = Target.Left
cellTop = Target.Top
cellWidth = Target.Width
cellHeight = Target.Height

' ファイルダイアログを作成
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .Title = "画像ファイルを選択してください"
    .Filters.Clear
    .Filters.Add "画像ファイル", "*.jpg;*.jpeg;*.png;*.bmp;*.gif"
    If .Show = -1 Then
       selectedFile = .SelectedItems(1)
    Else
       Exit Sub ' キャンセルされた場合は終了
    End If
End With

' 既存の画像を削除（必要に応じて）
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If Not Intersect(shp.TopLeftCell, Target) Is Nothing Then
       shp.Delete
    End If
Next shp

' 画像を挿入
Set img = ActiveSheet.Pictures.Insert(selectedFile)

' 画像の位置とサイズをセルに合わせる
With img
     .ShapeRange.LockAspectRatio = msoFalse '縦横比率を維持しない
     .Left = cellLeft
     .Top = cellTop
     .Width = cellWidth
     .Height = cellHeight
     .Placement = xlMoveAndSize
End With

Cancel = True ' ダブルクリックの標準動作をキャンセル

５．挿入したら、赤枠の「上書き保存」をクリックします。