EXCEL VBA エクセルシートに写真（画像）を挿入する・写真（画像）を表示・写真（画像）を削除（Picture）
EXCEL VBA エクセルシートに写真（画像）を挿入する・写真（画像）を表示・写真（画像）を削除（Picture）
社内でマニュアル作成や工事写真などEXCELシートに写真を挿入する事があると思いますが、ここでは、その写真（画像）をエクセルシートにVBAプログラムを利用して挿入する方法を説明いたします。特に写真を複数挿入する場合などは、手動で挿入するよりも、VBAプログラムを利用して写真（画像）を挿入する方が、簡単に挿入する事が出来ます。それでは、サンプルプログラムを交えて順番に説明いたします。
● ワークシートオブジェクト.Pictures.Insert(画像ファイルのフルパス)
●『使用例①』
ActiveSheet.Pictures.Insert(FileName)
FileName ＝ 画像ファイルのフルパスを指定
※詳しくは、サンプルプログラム①を参照
●『使用例②』
With Sheets(ﾜｰｸｼｰﾄ名).Pictures.Insert(写真のプルパス)
.Top = Range(セル番号).Top ‘画像の上位置
.Left = Range(セル番号).Left ‘画像の左位置
.Width = Range(セル番号).Width ‘画像の幅位置
.Height = Range(セル番号).Height ‘画像の高さ位置
End With
※詳しくは、サンプルプログラム②を参照
下記【Pictures.Insert メソッド】を利用したサンプルプログラムが①~④までありますが、【Pictures.Insert メソッド】の注意点を説明いたします。
※【Pictures.Insert メソッド】を利用すると次のメッセージが表示される場合があります。『リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイルう名と場所が指定されていることを確認してください。』とのエラーメッセージが表示が表示される場合があります。詳細は下記を参照して下さい。
【原因・理由】
※Pictures.Insert メソッドは、ワークシートに画像（写真）を挿入する事ができますが、ワークシートに挿入と共に、裏で画像のリンク先が登録されます。このリンク先が画像に登録されている状態は、リンク先の画像が別の場所へ移動したり、ファイルが削除されたり、ファイル名が変更するとエラーメッセージが表示されます。
【対応方法】
●図の通りに、Pictures.Insertメゾットで画像（写真）を挿入した場合は、必ず、挿入した画像を切り取り⇒貼り付けをする事で、不具合を解消する事ができます。なお、下記のサンプルプログラムは、全て不具合が発生しない様に、プログラムを作成しています。
写真（画像）ファイルをエクセルシートに挿入（画像を貼り付け）
下記のサンプルプログラムは、ワークシートに写真（画像）を挿入するサンプルプログラムですが、フルパスで指定した写真（画像）ファイル（1枚）をワークシートに挿入します。
●プログラム実行条件
ワークシート名を「Sheet1」
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 |
' '******** AKIRA55.COM ******* https://akira55.com/image/ ' Sub Image01() '写真（画像）ファイルをエクセルシートに挿入 With Sheets("Sheet1").Pictures.Insert("C:\DATA\写真01.png") .Top = Range("B2").Top '画像の上位置 .Left = Range("B2").Left '画像の左位置 .Cut '画像を切り取り（画像のリンク先を外すため） End With With Sheets("Sheet1") .Range("B2").Select .Pictures.Paste '画像を貼り付け（画像のリンク先を外すため） End With End Sub ' |
（画面クリックして拡大）
指定た画像ファイルを表示位置と大きさ（高さ・幅）を指定して挿入（表示）します。（サイズ調整）
下記のサンプルプログラムは、サンプルプログラム①同様に、ワークシートに写真（画像）を挿入するサンプルプログラムですが、今回は、ワークシート（Sheet1）のセルB2（サイズ）に収まる様に写真ファイル（1枚）を挿入して、大きさを調整してセル（B2）に挿入します。
●プログラム実行条件（下記のプログラムの実行するためには、必須条件です。）
ワークシート名を「Sheet1」
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
' '******** AKIRA55.COM ******* https://akira55.com/image/ ' Sub Image02() '指定た画像ファイルを表示位置と大きさ（高さ・幅）を指定して挿入（表示）します。 With Sheets("Sheet1").Pictures.Insert("C:\DATA\写真02.png") .Top = Range("B2").Top '画像の上位置 .Left = Range("B2").Left '画像の左位置 If .Width > Range("B2").Width Then 'セルB2の幅と画像の幅を比較する .Width = Range("B2").Width '画像の幅がセルB2の幅より大きい場合は、セルB2の幅に写真を合せる。 End If If .Height > Range("B2").Height Then 'セルB2の高さと画像の高さを比較する .Height = Range("B2").Height '画像の高さがセルB2のより高さが大きい場合は、セルB2の高さに写真を合せる。 End If .Cut '画像を切り取り（画像のリンク先を外すため） End With With Sheets("Sheet1") .Range("B2").Select .Pictures.Paste '画像を貼り付け（画像のリンク先を外すため） End With End Sub ' |
※上記のプログラムは、1つの写真を挿入するプログラムです。下記の実行結果では、別の2種類の写真（縦長写真・横長写真）の結果も含まれています。
（画面クリックして拡大）
指定したフォルダーとファイル名から画像ファイルを連続で取り込む（画像まとめて貼り付け）
下記のサンプルプログラムは、指定したフォルダーとファイル名から画像ファイルを連続で取り込むサンプルプログラムです。指定したフォルダー内に、同じような画像ファイルがあるので、このファイルを連続に指定したシートとセル番号へ挿入します。なお、画像ファイルを取り込む際は、挿入するセル（B列）サイズに合わせて画像を挿入します。
●プログラム実行条件（下記のプログラムの実行するためには、必須条件です。）
・ワークシート名を「Sheet1」
・画像のファイル名を「photo01~05」番号は１ずつの連番にする
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 |
' '******** AKIRA55.COM ******* https://akira55.com/image/ ' Sub Image03() '指定したフォルダーとファイル名から画像ファイルを連続で取り込む Dim I, P As Long P = 1 For I = 2 To 6 With Sheets("Sheet1").Pictures.Insert("C:\DATA\Photo0" & P & ".png") .Top = Range("B" & I).Top '画像の上位置 .Left = Range("B" & I).Left '画像の左位置 If .Width > Range("B" & I).Width Then 'セルB列の幅と画像の幅を比較する .Width = Range("B" & I).Width '画像の幅がセルB列の幅より大きい場合は、セルB列の幅に写真を合せる。 End If If .Height > Range("B" & I).Height Then 'セルB列の高さと画像の高さを比較する .Height = Range("B" & I).Height '画像の高さがセルB列のより高さが大きい場合は、セルB列の高さに写真を合せる。 End If .Cut '画像を切り取り（画像のリンク先を外すため） End With With Sheets("Sheet1") .Range("B" & I).Select .Pictures.Paste '画像を貼り付け（画像のリンク先を外すため） End With P = P + 1 Next I End Sub ' |
（画面クリックして拡大）
ダイアログボックスが表示して、挿入したい画像ファイルを複数選択してシートに一括挿入（表示）する（画像を選択して貼り付け）
なお、画像ファイルを取り込む際は、セルサイズ（B列）に合わせて挿入されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
' '******** AKIRA55.COM ******* https://akira55.com/image/ ' Sub Image04() 'ダイアログボックスが表示して、挿入したい画像ファイルを複数選択してシートに一括挿入（表示）する Dim FileName As Variant Dim I, F As Long FileName = Application.GetOpenFilename(MultiSelect:=True) 'ダイアログボックスが表示（MultiSelect:=Trueでファイルを複数選択） On Error GoTo err_shori I = 2 For F = 1 To UBound(FileName) '選択したファイル数（最大値）まで繰り返します。 With Sheets("Sheet1").Pictures.Insert(FileName(F)) .Top = Range("B" & I).Top '画像の上位置 .Left = Range("B" & I).Left '画像の左位置 If .Width > Range("B" & I).Width Then 'セルB列の幅と画像の幅を比較する .Width = Range("B" & I).Width '画像の幅がセルB列の幅より大きい場合は、セルB列の幅に写真を合せる。 End If If .Height > Range("B" & I).Height Then 'セルB列の高さと画像の高さを比較する .Height = Range("B" & I).Height '画像の高さがセルB列のより高さが大きい場合は、セルB列の高さに写真を合せる。 End If .Cut '画像を切り取り（画像のリンク先を外すため） End With With Sheets("Sheet1") .Range("B" & I).Select .Pictures.Paste End With I = I + 1 '次のセルに加算する。（セルの移動＋１） Next F MsgBox UBound(FileName) & "個の画像ファイルが挿入されました。" Exit Sub err_shori: 'ダイアログボックスをそのまま閉じる。ファイルを選択しないでキャンセルした場合は、この場所に飛びます。 MsgBox "キャンセルされました。" End Sub ' |
（画面クリックして拡大）
アクティブシート内の画像（写真）を全て削除します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
' '******** AKIRA55.COM ******* https://akira55.com/image/ ' Sub Image_Delete01() 'アクティブシート内の画像を全て削除します。 Dim Image_del As Picture For Each Image_del In ActiveSheet.Pictures 'アクティブシート上の画像を全て対象し繰り返す。 Image_del.Delete 'シート上の画像を削除する。 Next Image_del '画像がなくなりまで繰り返す。 End Sub ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。