VBA 写真複数挿入の際にファイルのリンクではなく直接写真をエクセルに貼りたい

前提・実現したいこと

ＶＢＡで特定のセルをクリックすると複数写真が挿入されるコードなのですが
今組んでいるコードが写真をファイルリンクで挿入するコードになっております。
そこで、直接エクセルに写真を貼りつけるコードにしたいのですが
中々うまくいきません。どなたか、ご教授お願い致します。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
Dim fName As Variant
Dim i As Long
Dim Pict As Picture

 If Target.Columns.Count = 6 And Target.Rows.Count = 11 Then

fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True)
If IsArray(fName) Then
    Application.ScreenUpdating = False
    '配列に格納されたファイル名をソート
    BubbleSort fName, True
    For i = 1 To UBound(fName)
        Set Pict = ActiveSheet.Pictures.Insert(fName(i))
        With Pict
            .TopLeftCell = ActiveCell
            .ShapeRange.LockAspectRatio = msoFalse
         .ShapeRange.Height = Selection.Height 'セルの高さリサイズ
        .ShapeRange.Width = Selection.Width  'セルの幅にリサイズ
        End With
        ActiveCell.Offset(5, 0).Activate
        Application.StatusBar = "処理中：" & i & "/" & UBound(fName) & "枚目"
    Next i
End If
With Application
    .StatusBar = False
    .ScreenUpdating = True
End With
Set Pict = Nothing

End If
End Sub

'値の入替え
Public Sub Swap(ByRef Dat1 As Variant, ByRef Dat2 As Variant)

Dim varBuf As Variant
varBuf = Dat1
Dat1 = Dat2
Dat2 = varBuf

End Sub

'配列のバブルソート
Public Sub BubbleSort(ByRef aryDat As Variant, _
Optional ByVal SortAsc As Boolean = True)

Dim i As Long
Dim j As Long
For i = LBound(aryDat) To UBound(aryDat) - 1
    For j = LBound(aryDat) To LBound(aryDat) + UBound(aryDat) - i - 1
        If aryDat(IIf(SortAsc, j, j + 1)) > aryDat(IIf(SortAsc, j + 1, j)) Then
            Call Swap(aryDat(j), aryDat(j + 1))
        End If
    Next j
Next i

End Sub

試したこと

Set Pict = ActiveSheet.Pictures.Insert(fName(i))
ここを何度か変えようとしたのですが、組み方が分からず断念しました。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

行動規範の内容に同意します

回答1件

ベストアンサー

Pictures.Insert メソッドではなく、Shapes.AddPicture メソッドを使用してください。
Excel 2010 で Pictures.Insert メソッドを使用して図をワークシートに挿入すると図がリンクオブジェクトとして挿入される

サンプルコード

VBA
1Sub InsPict()
2
3    Dim objFileName As String
4    Dim objShape As Shape
5
6    objFileName = Application.GetOpenFilename _
7    ("Pictures (*.gif; *.jpg; *.bmp; *.tif),*.gif; *.jpg; *.bmp; *.tif", , "画像選択ダイアログ")
8
9'アクティブセルの位置に図の幅と高さを 50 ポイントに指定して画像を挿入します
10
11    Set objShape = ActiveSheet.Shapes.AddPicture( _
12    Filename:=objFileName, _
13    LinkToFile:=False, _
14    SaveWithDocument:=True, _
15    Left:=Selection.Left, _
16    Top:=Selection.Top, _
17    Width:=50#, _
18    Height:=50#)
19
20'図のサイズを元のサイズに戻します
21
22    With objShape
23        .ScaleHeight 1!, msoTrue
24        .ScaleWidth 1!, msoTrue
25    End With
26
27End Sub