指定のセルの位置に画像ファイルのイメージを等倍で貼り付けるVBAのサブプロシージャ

PasteImageFromFile.vba

' 指定のセルの位置に画像ファイルのイメージを等倍で貼り付ける
Private Sub PasteImageFromFile(targetRange As Range, imageFilePath As String)
    Dim image As Shape
    Dim startingSheet As Worksheet
    
    ' 処理開始前のシートを記録する
    Set startingSheet = ActiveSheet
    
    targetRange.Worksheet.Activate
    targetRange.Select
    
    ' Width/Heightの値はダミー
    Set image = targetRange.Worksheet.Shapes.AddPicture( _
        Filename:=imageFilePath, _
        LinkToFile:=False, _
        SaveWithDocument:=True, _
        Left:=Selection.Left, Top:=Selection.Top, _
        Width:=0, Height:=0)
    
    ' サイズを等倍にする
    With image
        .ScaleWidth 1, msoTrue
        .ScaleHeight 1, msoTrue
    End With
    
    ' 処理開始前のシートに戻る
    startingSheet.Activate
End Sub