画像ファイルそのものを貼り付けたい

Question

写真帳で以下のコードを使っているのですが画像をリンクではなくファイルそのものを貼り付けし保存したい。
もしくはAddPictureにてセルの中心に画像を貼り付ける方法を教えていただきたいです。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
                                        Cancel As Boolean)
   Dim myPic
   Dim myRange As Range '画像を配置するセル範囲
   Dim rX As Double, rY As Double


    myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")  '画像選択
    If VarType(myPic) = vbBoolean Then Exit Sub
     
    Set myRange = Target 'このセル範囲に収まるように画像を縮小する
     
    Application.ScreenUpdating = False
    With ActiveSheet.Pictures.Insert(myPic).ShapeRange
        rX = myRange.Width / .Width
        rY = myRange.Height / .Height
        If rX > rY Then
            .Height = .Height * rY
        Else
            .Width = .Width * rX
        End If
        .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
        .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置


End With
    Application.ScreenUpdating = True
    Cancel = True
End Sub

Comments

[y_waiwai]

言語と動作環境はなにを対象としてるんでしょうか

[nac_tnk]

PIC　→　https://akizukidenshi.com/catalog/c/cpicr/