画像(図)をシートに挿入 | Pictures.Insertメソッドの方法と注意点

ExcelVBAを使用して、フォルダ内に保存されている画像をシートに配置する方法です。

Pictures.Insertメソッドの注意点

Pictures.Insertメソッドでワークシートに画像（図）を挿入すると、次のような場合は画像が表示されません。

このようになる理由は、画像がリンク オブジェクトとして挿入されるためです。

画像の挿入方法

ワークシートに1つの画像を挿入する方法です。

基本

次の場所に保存されているファイルをアクティブシートに貼り付ける例です。

• 保存先：F:\sample
• ファイル名：青森.png

Sub sample1()
ActiveSheet.Pictures.Insert "F:\sample\青森.png"
End Sub

もとのサイズでシートに画像が挿入されます。

別シートから画像を挿入しサイズを変更する

エクセルブックに2つのワークシートがある場合です。

1. 一覧：ファイルの保存先パスとファイル名が入力されているシート
2. 貼付先：画像貼り付け先シート

一覧

• A列：ファイル名（拡張子なし）
• B列：画像配置後に「済」と表示します。保存先に該当のファイルが存在しない場合は空欄。

貼付先

• セルA1にファイル名（拡張子なし）
• セルA2に画像配置

サンプルコード

• 2つのワークシートのどちらを選択していても実行可能
• 画像サイズ：Range("A2:H22")

Sub sample2()
Dim sWB As Workbook, sWH As Worksheet, hWH As Worksheet
    Set sWB = ActiveWorkbook
    Set sWH = sWB.Worksheets("一覧")
    Set hWH = sWB.Worksheets("貼付先")
    Dim fPath As String: fPath = sWH.Range("D1")
    Dim cName As String, fName As String

    With sWH
         cName = .Range("A2")
         fName = fPath & .Range("A2") & ".png"
    End With
    
    If Dir(fName) <> "" Then
        With hWH.Pictures.Insert(fName)
                .Name = cName
                .Top = Range("A2").Top
                .Left = Range("A2").Left
                .ShapeRange.LockAspectRatio = msoFalse
                .Width = Range("A2:H2").Width
                .Height = Range("A2:A22").Height
                 hWH.Range("A1").Value = cName
         End With
         sWH.Range("B2").Value = "済"
    End If
End Sub

• 10行目：挿入するファイル名（拡張子なし）
• 11行目：挿入するファイル名（パス含む）
• 14・25行目：挿入するファイル名があったら処理を実行します。
• 15行目：画像挿入
• 16行目：画像に名前を付けます。ファイル名（拡張子なし）
• 17～18行目：画像の位置を設定します。
• 19～22行目：画像のサイズを設定します。
• 22行目：セルA1にファイル名（拡張子なし）を表示します
• 24行目：セルB2に「済」と表示します。

縦横の比率を固定で、縦のサイズだけ指定する例です。19～21行目を変更します。

.ShapeRange.LockAspectRatio = msoTrue
.Height = 280

サイズ指定方法は他にも方法があります。

複数の画像を指定した位置に挿入する

エクセルブックに2つのワークシートがある例です。

1. 一覧：ファイルの保存先パスとファイル名が入力されているシート
2. 貼付先：画像貼り付け先シート

一覧

• B列：ファイル名（拡張子なし）
• C列：貼り付け先の行番号（タイトル入力先）
• D列：貼り付け先の列番号
• E列：画像配置後に「済」と表示します。保存先に該当のファイルが存在しない場合は空欄。

貼付先

縦横の比率を固定で高さを指定する例の結果です。

サンプルコード

ファイル[貼付先]をアクティブにしてマクロを実行します。

Sub sample3()
    Dim sWB As Workbook, sWH As Worksheet, hWH As Worksheet
    Set sWB = ActiveWorkbook
    Set sWH = sWB.Worksheets("一覧")
    Set hWH = sWB.Worksheets("貼付先")
    Dim fPath As String: fPath = sWH.Cells(1, 7)
    Dim gNo As String, cName As String, fName As String
    Dim i As Long, r As Long, c As Long
    
    For i = 2 To sWH.Cells(Rows.Count, 1).End(xlUp).Row
        With sWH
             gNo = .Cells(i, 1)
             cName = .Cells(i, 2)
             r = .Cells(i, 3)
             c = .Cells(i, 4)
             fName = fPath & .Cells(i, 2) & ".png"
        End With
    
        If Dir(fName) <> "" Then
            With hWH.Pictures.Insert(fName)
                    .Name = cName
                    .Top = Cells(r + 1, c).Top
                    .Left = Cells(r + 1, c).Left
                    .ShapeRange.LockAspectRatio = msoTrue
                    .Height = 280
                     hWH.Cells(r, c).Value = "No." & gNo & "_" & cName
             End With
            sWH.Cells(i, 5) = "済"
        End If
    Next i
End Sub