VBA｜Excel｜画像挿入｜Pictures.Insert＋縦横比固定＋サイズ調整＋セル位置へ配置（Top/Left）

基本構文

（実務テンプレ：画像を挿入してセル位置に合わせる）

○ 挿入：

Set pic = ActiveSheet.Pictures.Insert({画像フルパス})

○ 縦横比固定：

pic.ShapeRange.LockAspectRatio = msoTrue

○ サイズ調整：

pic.Height = {高さ}

（縦横比固定なら幅は自動追従）

○ 位置合わせ：

pic.Top = Cells(r, c).Top
pic.Left = Cells(r, c).Left

○ 解放：

Set pic = Nothing

（戻り値の型・性質）

○ Pictures.Insert：Picture（Excelの画像オブジェクト参照） 　
○ ShapeRange.LockAspectRatio：/MsoTriState（msoTrue/msoFalse） 　
○ Top/Left/Height：Single（ポイント単位の座標・サイズ）

サンプルコード

サンプル①：セルの位置に画像を置き、高さ110で縦横比固定 役割：ファイル名列の画像を挿入し、画像列のセル左上に配置する 理由：縦横比固定＋高さ固定で見た目を揃え、Top/Leftでセル基準に整列する 注意：Pictures.Insert は ActiveSheet に入るので、対象シートを明示したい場合は objWS.Pictures.Insert に寄せる

Option Explicit
Sub InsertAndPlacePicture()
    Dim objWS As Worksheet: Set objWS = ActiveSheet
    Dim objPic As Picture

    Dim i As Long
    Dim lngBeforeFileNameCol As Long: lngBeforeFileNameCol = 2 '例：B列がファイル名
    Dim lngImageCol As Long:          lngImageCol = 5          '例：E列に画像を置く
    Dim strFolderPath As String:      strFolderPath = "C:\Temp\Images"

    i = 2 '例：2行目

    ' 挿入する画像をオブジェクトにセット
    Set objPic = objWS.Pictures.Insert(strFolderPath & "\" & objWS.Cells(i, lngBeforeFileNameCol).Value)

    ' 画像比率に合わせる（縦横比固定）
    objPic.ShapeRange.LockAspectRatio = msoTrue

    ' 画像の高さを設定（幅は比率に合わせて追従）
    objPic.Height = 110

    ' サイズ変更後、画像挿入位置（セル左上）へ移動
    objPic.Top = objWS.Cells(i, lngImageCol).Top
    objPic.Left = objWS.Cells(i, lngImageCol).Left

    ' 画像オブジェクト解放
    Set objPic = Nothing
End Sub

備考

・Pictures.Insert は 指定パスが存在しない と実行時エラーになりやすいので、実務では Dir(fullPath)<>"" で事前チェックするのが安全。
・画像のアンカーは「セルに貼り付く/貼り付かない」挙動が絡む。必要なら objPic.Placement = xlMoveAndSize などの指定を追加する（運用で選ぶ）。
・Top/Left はポイント座標なので、セルの Top/Left を使うと「セル左上ピッタリ」に揃えられる。
・LockAspectRatio は ShapeRange 側のプロパティ。Picture を Shape として扱う流れなので、この順（固定→サイズ→移動）が安定。