【エクセルマクロ】画像挿入について教えてください。

Excel2010で下記マクロを実行し、 画像挿入元のフォルダ名を変更・削除したり、メールに添付して送信したりすると「リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と場所が指定されていることを確認してください。」
と表示されます。

Excel2010では、Shapes.Addメソッドを使用するとリンク解除ができるとのことで、
初心者ながら色々試してみたのですが、うまくいきません。
マクロ初心者のため、詳しく教えていただけると大変助かります。

Private Sub Del_Btn_Click()
指定セル範囲 = "C18:K500"
With ActiveSheet
Set セル範囲 = .Range(指定セル範囲)
For Each 図形 In .Shapes
If 図形.Type = msoPicture Then
Set 共有セル範囲 _
= Intersect(Range(図形.TopLeftCell, 図形.BottomRightCell), セル範囲)
If Not (共有セル範囲 Is Nothing) Then
図形.Delete
End If
End If
Next
End With

End Sub

Private Sub Ins_Btn_Click()
Dim fName As Variant
Dim i As Long
Dim j As Integer
Dim k As Integer
Dim Pict As Picture
Const z1 As Long = 246 'サイズ指定
Const z2 As Long = 184 'サイズ指定
Dim z3 As Long '上位置

z3 = 306
k = 1

fName = Application.GetOpenFilename("JPGファイル, *.jpg", MultiSelect:=True)
If IsArray(fName) Then
Application.ScreenUpdating = False
'配列に格納されたファイル名をソート
BubbleSort fName, True
'If UBound(fName) >= 19 Then
' j = 19
' Else
j = UBound(fName)
'End If

For i = 1 To j
Set Pict = ActiveSheet.Pictures.Insert(fName(i))

If i Mod 6 = 5 Then
z3 = z3 + 18.5 - k
k = k + 0.5
End If

If i Mod 2 = 1 Then
With Pict
.Width = z1 '横型
.Height = z2 '縦型
.Top = z3 + 146.5 * (i - 1) '上位置
.Left = 83 '左位置
.Locked = False
ico = ico + z1 + 10 '間隔指定
End With
Else
With Pict
.Width = z1 '横型
.Height = z2 '縦型
.Top = z3 + 146.5 * (i - 2) '上位置
.Left = 350 '左位置
.Locked = False
ico = ico + z1 + 10 '間隔指定
End With
End If

ActiveCell.Offset(2, 0).Activate
Application.StatusBar = "処理中：" & i & "/" & UBound(fName) & "枚目"
Next i
End If
With Application
.StatusBar = False
.ScreenUpdating = True
End With
Set Pict = Nothing

If i > 0 Then
MsgBox j & "枚の画像を挿入しました", vbInformation
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

どうぞよろしくお願いいたします。

No.4 回答者： mindatg 回答日時： 2013/10/30 15:52

投稿したあとで気づいてしまいました

＞ActiveSheet.Shapes.AddPicture(Filename:=fName(i),LinkToFile:=True,SaveWithDocument:=False,Left:=Selection.Left,Top:=Selection.Top,Width:=0,Height:=0)
こうだと画像がリンクになってしまうので

ActiveSheet.Shapes.AddPicture(Filename:=fName(i),LinkToFile:=False,SaveWithDocument:=True,Left:=Selection.Left,Top:=Selection.Top,Width:=0,Height:=0)
こうで。

No.3 回答者： mindatg 回答日時： 2013/10/30 15:51

No1の方

＞With ActiveSheet.Picture.Insert(fName(i)).ShapeRange
を
With Sheets("シート名").Picture.Insert(fName(i)).ShapeRange
これでも駄目なら、マクロの2行目か3行目あたりにF９キーでブレークポイントを貼ってマクロ実行、F１０キーで1行づつ進めて行き、エラーが発生する行を見つけ
その行をコメントアウトしてみてください。


No2の方
＞Set Pict = ActiveSheet.Shapes.AddPicture(Filename:=fName(i),LinkToFile:=False,SaveWithDocument:=True)
を
ActiveSheet.Shapes.AddPicture(Filename:=fName(i),LinkToFile:=True,SaveWithDocument:=False,Left:=Selection.Left,Top:=Selection.Top,Width:=0,Height:=0)
引数省略すんな、とエラーが出てるので必要な引数を全て付与。あとはWith Pict 以降の行で再設定しているので大丈夫かと思います。

No.2 回答者： mindatg 回答日時： 2013/10/29 17:39

もう１つの方法です、

というか最初の回答が質問の趣旨に沿ってなかったので。

'Dim Pict As Picture を、下記に
Dim Pict As Shape

'Set Pict = ActiveSheet.Pictures.Insert(fName(i)) を、下記に
Set Pict = ActiveSheet.Shapes.AddPicture(Filename:=fName(i),LinkToFile:=False,SaveWithDocument:=True)

'.Locked = False は消すかコメントアウト

そこだけ書き換えれば同じように動作するはずです。
リンク貼り付けなんかやファイルサイズを軽くするならこっちの方が便利かもですね。

この回答への補足

ご丁寧にありがとうございます。

修正したのですが、「実行時エラー450：引数の数が一致していません。または不正なプロパティを指定しています。」となってしまいます。

何度も申し訳ございません。
どうぞよろしくお願いいたします。

補足日時：2013/10/29 17:59

No.1 回答者： mindatg 回答日時： 2013/10/29 17:18

Picture変数を使わず、貼り付けています。

こちらは元ファイルを消してから開き直してもリンク云々言わないはずです。

For i = 1 To j
'''DEL'''Set Pict = ActiveSheet.Pictures.Insert(fName(i))

If i Mod 6 = 5 Then
z3 = z3 + 18.5 - k
k = k + 0.5
End If

'★画像ファイルを挿入する
' Ifの分岐で2回もWihtするくらいならIfより前で1回だけに済ませる
' ActiveSheetで不都合があるならSheet("SHEET名")に。
With ActiveSheet.Picture.Insert(fName(i)).ShapeRange


If i Mod 2 = 1 Then
'''DEL'''With Pict
.Width = z1 '横型
.Height = z2 '縦型
.Top = z3 + 146.5 * (i - 1) '上位置
.Left = 83 '左位置
'''DEL'''.Locked = False
ico = ico + z1 + 10 '間隔指定
'''DEL'''End With
Else
'''DEL'''With Pict
.Width = z1 '横型
.Height = z2 '縦型
.Top = z3 + 146.5 * (i - 2) '上位置
.Left = 350 '左位置
'''.Locked = False
ico = ico + z1 + 10 '間隔指定
'''DEL'''End With
End If

'★With ActiveSheet.Picture.Insert(fName(i)).ShapeRange　の終わり
End With

この回答への補足

ご回答いただきありがとうございます。

ご指摘いただいたところを修正いたしましたが、
「実行時エラー　438：オブジェクトは、このプロパティまたはメソッドをサポートしていません。」
と表示されてしまいます。

マクロ初心者のため、どうすればよいかがわかりません。
対応策をご教示いただけますと大変助かります。
どうぞよろしくお願いいたします。

補足日時：2013/10/29 17:50