EXCEL VBA セルで選択した場所に画像を挿入・シートに画像挿入作業を効率化する方法（テクニック）

2023年6月3日

EXCEL VBA セルで選択した場所に画像を挿入・シートに画像挿入作業を効率化する方法（テクニック）

●はじめに

今回説明するサンプルプログラムは、VBAを使用してExcelワークシートに画像を自動的に挿入し、その位置とサイズを調整する方法について説明します。これは、工事写真や製品カタログを作成するときや、画像を含む報告書を作成するときなど、様々な事務作業で役立つと思います。また、複数の画像ファイルをワークシートに取り込む事もできるので、業務の効率を図る事ができます。

●【EXCEL VBA エクセルシートに写真（画像）を挿入する・写真（画像）を削除、については、下記を参照して下さい】

EXCEL VBA エクセルシートに写真（画像）を挿入する・写真（画像）を表示・写真（画像）を削除（Picture）

EXCEL VBA ダブルクリックだけ！Excelのセルに画像を挿入する方法

●プログラム説明　(サンプル①)

下記のサンプルプログラムは、ユーザーがEXCELシートの特定のセルをクリックして選択した画像を挿入するサンプルプログラムです。具体的には、セルの（A2, C2, A4, C4, A6, C6）をダブルクリックすると、画像ファイル選択ダイアログを表示し、選択された画像をそのセルに挿入する動作をするものです。EXCELシートに画像ファイルを挿入する作業は、手間が掛るのでこのサンプルプログラムを利用する事で簡単にEXCELシートへ画像を挿入する事ができます。工事管理写真などを管理する場合は便利だと思います。

【プログラムの流れ】
①　ユーザーがセルをダブルクリックする。
②　ターゲットとなるセルが特定のセルのいずれかであることを確認する。
③　ダイアログを作成し、ユーザーに画像ファイルを選択させる。
④　ユーザーがファイルを選択すると、そのファイルをダブルクリックしたセルに挿入する。
⑤　挿入された画像のサイズと位置を調整する。

【プログラム実行条件・注意事項】
①　このコードは特定のセル（A2, C2, A4, C4, A6, C6）に対してのみ機能します。他のセルをダブルクリックしても何も起こりません。
②　選択可能な画像ファイル形式はGIF、JPG、JPEG、BMP、PNG、TIFです。他の形式のファイルは選択できません。
③　挿入された画像は、セルのサイズに合わせて自動的にリサイズされます。セルのサイズを変更すると、画像のサイズもそれに合わせて変わります。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　insertimages01（サンプルプログラム）

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' ターゲットセルが指定したセル（A2, C2, A4, C4, A6, C6）のいずれでもない場合、CancelをTrueに設定します。
    Cancel = True

    ' ターゲットセルが指定したセル（A2, C2, A4, C4, A6, C6）のいずれかであれば、処理を実行します。
    If Not Intersect(Target, Union(Range("A2"), Range("C2"), Range("A4"), Range("C4"), Range("A6"), Range("C6"))) Is Nothing Then
        ' ファイル選択ダイアログを作成します。
        Dim fd As FileDialog
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
        With fd
            .Title = "Select an Image File"  ' ダイアログのタイトルを設定します。
            .Filters.Clear  ' 既存のフィルターをクリアします。
            .Filters.Add "Image Files", "*.GIF; *.JPG; *.JPEG; *.BMP; *.PNG; *.TIF", 1  ' 画像ファイルのフィルターを追加します。

            ' ダイアログで画像が選択されたら、その画像をダブルクリックされたセルに挿入します。
            If .Show = -1 Then
                Dim Picture As Picture
                Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(1))

                ' 挿入した画像のサイズと位置をダブルクリックされたセルに合わせます。
                With Picture
                    With .ShapeRange
                        .LockAspectRatio = msoFalse
                        .Width = Target.Width
                        .Height = Target.Height
                    End With
                    .Left = Target.Left
                    .Top = Target.Top
                    .Placement = xlMoveAndSize
                End With
            End If
        End With
    End If
End Sub

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

' ターゲットセルが指定したセル（A2, C2, A4, C4, A6, C6）のいずれでもない場合、CancelをTrueに設定します。

Cancel = True

' ターゲットセルが指定したセル（A2, C2, A4, C4, A6, C6）のいずれかであれば、処理を実行します。

If Not Intersect(Target, Union(Range("A2"), Range("C2"), Range("A4"), Range("C4"), Range("A6"), Range("C6"))) Is Nothing Then

' ファイル選択ダイアログを作成します。

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

.Title = "Select an Image File" ' ダイアログのタイトルを設定します。

.Filters.Clear ' 既存のフィルターをクリアします。

.Filters.Add "Image Files", "*.GIF; *.JPG; *.JPEG; *.BMP; *.PNG; *.TIF", 1 ' 画像ファイルのフィルターを追加します。

' ダイアログで画像が選択されたら、その画像をダブルクリックされたセルに挿入します。

If .Show = -1 Then

Dim Picture As Picture

Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(1))

' 挿入した画像のサイズと位置をダブルクリックされたセルに合わせます。

With Picture

With .ShapeRange

.LockAspectRatio = msoFalse

.Width = Target.Width

.Height = Target.Height

End With

.Left = Target.Left

.Top = Target.Top

.Placement = xlMoveAndSize

End With

End If

End With

End If

End Sub

●実行前～実行後　※Excelの特定のセル（A2, C2, A4, C4, A6, C6）をダブルクリックすると画像選択ダイアログが表示されます。選択した画像は、ダブルクリックしたセルに挿入され、そのセルのサイズに自動的に合わせられます。
（画面クリックして拡大）

EXCEL VBA 複数の画像ファイルを自動的に順番に挿入する方法（複数のイメージファイルをワークシートに配置）

●プログラム説明　(サンプル②)

下記のサンプルプログラムは、Excelのワークシートに画像を挿入するためのものです。ユーザーがダイアログボックスから複数の画像ファイルを選択すると、選択した画像がワークシートに自動的に挿入されます。挿入される画像のサイズと位置は自動調整され、画像ファイルは指定したセルに適切にフィットするようになっています。画像ファイルがワークシートに取り込まれ、Ａ列に画像のファイル名（奇数行）・画像（偶数行）の順番に挿入されます。

【プログラムの流れ】
①　ダイアログボックスが表示され、画像ファイルの複数選択を行います。
②　選択した各画像について、以下の処理を行います：
②－１ファイル名を対応するセルに挿入します。
②－２画像をワークシートに挿入します。
②－３挿入した画像のサイズと位置を調整します。

【プログラム実行条件・注意事項】

①　現在のアクティブシートにのみ画像を挿入します。他のシートに画像を挿入する場合は、コードを適切に調整する必要があります。
②　ユーザーが画像ファイルを選択することを前提としています。画像ファイルが選択されなかった場合、以下の通り続きます。
③　ユーザーが画像ファイルを選択することを前提としています。画像ファイルが選択されなかった場合、コードは何も行いません。
④　選択した画像が適切に表示できることを前提としています。画像が大きすぎる場合や、対応するセルが存在しない場合などは、想定外の結果が生じる可能性があります。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　insertimages02　（サンプルプログラム）

'
'
Sub InsertImages02()
    ' コメント：ダイアログボックスを開き、画像ファイルを選択します。
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Title = "Select Image Files"
        .Filters.Clear
        .Filters.Add "Image Files", "*.GIF; *.JPG; *.JPEG; *.BMP; *.PNG; *.TIF", 1
        .AllowMultiSelect = True  ' コメント：複数選択を許可します。

        ' コメント：選択した画像ファイルを開きます。
        If .Show = -1 Then
            Dim i As Long
            For i = 1 To .SelectedItems.Count
                ' コメント：奇数行にファイル名を表示します（フルパスではなく）。
                Dim fileName As String
                fileName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))
                Range("A" & (2 * i - 1)).Value = fileName
                
                Dim Picture As Picture
                Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(i))
                
                ' コメント：選択した画像を対応するセル（A2を起点に下方向）に配置し、サイズを調整します。
                With Picture
                    With .ShapeRange
                        .LockAspectRatio = msoFalse
                        .Width = Range("A" & (2 * i)).Width
                        .Height = Range("A" & (2 * i)).Height
                    End With
                    .Left = Range("A" & (2 * i)).Left
                    .Top = Range("A" & (2 * i)).Top
                    .Placement = xlMoveAndSize
                End With
            Next i
        End If
    End With
End Sub
'
'

Sub InsertImages02()

' コメント：ダイアログボックスを開き、画像ファイルを選択します。

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

.Title = "Select Image Files"

.Filters.Clear

.Filters.Add "Image Files", "*.GIF; *.JPG; *.JPEG; *.BMP; *.PNG; *.TIF", 1

.AllowMultiSelect = True ' コメント：複数選択を許可します。

' コメント：選択した画像ファイルを開きます。

If .Show = -1 Then

Dim i As Long

For i = 1 To .SelectedItems.Count

' コメント：奇数行にファイル名を表示します（フルパスではなく）。

Dim fileName As String

fileName = Right(.SelectedItems(i), Len(.SelectedItems(i)) - InStrRev(.SelectedItems(i), "\"))

Range("A" & (2 * i - 1)).Value = fileName

Dim Picture As Picture

Set Picture = ActiveSheet.Pictures.Insert(.SelectedItems(i))

' コメント：選択した画像を対応するセル（A2を起点に下方向）に配置し、サイズを調整します。

With Picture

With .ShapeRange

.LockAspectRatio = msoFalse

.Width = Range("A" & (2 * i)).Width

.Height = Range("A" & (2 * i)).Height

End With

.Left = Range("A" & (2 * i)).Left

.Top = Range("A" & (2 * i)).Top

.Placement = xlMoveAndSize

End With

Next i

End If

End With

End Sub

●実行前～実行後　※プログラムを実行後、ファイルダイアログが表示され、ユーザーは画像ファイルを選択できます。選択した各画像は、ワークシートに挿入され、適切なセルにフィットするようにサイズと位置が調整されます。また、選択した画像のファイル名が、対応するセルに表示されます。
（画面クリックして拡大）

EXCEL VBA　一瞬でExcelシートの画像を全削除・シートをクリーンにする！

●プログラム説明　(サンプル③)

下記のサンプルプログラムは、Excelのアクティブシート上に存在する全ての画像を削除するためのものです。実行する前にはユーザーに確認メッセージを提示し、ユーザーが「はい」を選択した場合にのみ、画像の削除を実行します。プログラム実行後、ユーザーに確認メッセージを表示します: “全ての画像を削除してもよろしいですか？”のメッセージでユーザーが「はい」を選択した場合、アクティブシート上の全ての画像を削除します。

【プログラムの流れ】
①　ユーザーに削除の確認メッセージを表示します。
②　ユーザーが「はい」を選択した場合、次の処理を実行します。それ以外の場合、処理は終了します。
③　アクティブシート上の全ての画像を取得します。
④　各画像に対して削除操作を行います。

【プログラム実行条件・注意事項】
①　アクティブシート上の全ての画像を削除します。削除したい特定の画像だけを選択する機能はありません。そのため、必要な画像が混在している場合は注意が必要です。
②　画像が削除されると元に戻すことはできません。したがって、重要な画像が含まれている可能性がある場合は、コードを実行する前にシートのコピーを作成することをお勧めします。
③　このプログラムは、アクティブシート（現在開いているシート）のみに影響します。他のシートにある画像は影響を受けません。

★【サンプルプログラム】
下記のリンク先よりサンプルプログラムをダウンロードする事ができます。
●　insertimages02　（サンプルプログラム）

'
'
Sub DeleteAllPictures() '画像の一括削除
    ' ユーザーに削除の確認を求めるメッセージボックスを表示
    If MsgBox("全ての画像を削除してもよろしいですか？", vbYesNo + vbQuestion, "確認") = vbYes Then
        ' 確認が取れた場合、以下の処理を行う
        
        ' 各画像に対して操作を行うための変数を定義
        Dim pic As Picture
        
        ' アクティブシートの全ての画像に対してループ
        For Each pic In ActiveSheet.Pictures
            ' 画像を削除
            pic.Delete
        Next pic
    End If
End Sub
'
'