Excel2019 マクロを使用し画像を貼り付けした際のリンク切れについて

下記のような指定された大きさの結合セルにダブルクリックで画像を貼り付けるマクロを使用しているのですが、画像がリンク切れを起こしてしまうため対処方法をお教え頂けないでしょうか。
一通り調べはしたため原因は分かったのですが、マクロについてほとんど知らずどの部分をどう直せば解消されるかがわからず困っております。何卒宜しくお願い致します。

使用OS：Windows10
Excel：Microsoft® Excel® 2019 MSO (バージョン 2210 ビルド 16.0.15726.20188) 32bit
エラー内容：リンクされたイメージを表示できません


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim TWD, THT, TTP, TLF, PWD, PHT, FName
Cancel = True

'================写真を貼り付けたい範囲の調整をここで行う。
If Not (Target.Columns.Count = 10 And Target.Rows.Count = 7) Then Exit Sub
'================上の23と19を好みのセルの結合した大きさに変えてください。
Application.ScreenUpdating = False

TWD = Target.Width '対象セルの幅
THT = Target.Height
TTP = Target.Top
TLF = Target.Left
FName = Application.GetOpenFilename
If FName = False Then Exit Sub
ActiveSheet.Pictures.Insert(FName).Select
With Selection.ShapeRange
.LockAspectRatio = msoTrue
PWD = .Width '画像の幅
PHT = .Height
Select Case PHT / PWD
Case Is >= THT / TWD
.Height = THT - 8
.Top = TTP + 4
.Left = TLF + (TWD - .Width) / 2
Case Else
.Width = TWD - 8
.Top = TTP + (THT - .Height) / 2
.Left = TLF + 4
End Select
End With
Application.ScreenUpdating = True
End Sub

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/11/15 16:44

こんにちは

＞画像がリンク切れを起こしてしまうため対処方法をお教え頂けないでしょうか。
画像を貼り付ける際に、リンクを指定して記憶しているので、元の画像が移動したり削除されたりすると、ご質問のように「リンク切れ」となって表示できません。

常に表示できるようになさりたければ、貼り付けの際に画像そのものを取り込んでしまって、エクセルのデータとして一緒に保存するようにしておけば「リンク切れ」はおきなくなります。
（当然ですが、画像データを取り込むので、データ量は大きくなります）

以下のサイトに詳細な説明がありますが、
Shapes.AddPictureメソッドを用いて、SaveWithDocumentのオプションを指定しておけば可能になるでしょう。
https://excel-ubara.com/excelvba5/EXCELVBA226.html

この回答へのお礼

早急にご回答いただきありがとうございました。
無事解決いたしました。最初にお答えいただいたためベストアンサーとさせていただきました。

お礼日時：2022/11/16 08:17

No.2 回答者： Qchan1962 回答日時： 2022/11/15 16:55

こんにちは

リンク切れを起こすのは　Pictures.Insert　を使用している為です
（Insert　リンク挿入です）
なのでAddPictureを使用してLinkToFile:=Falseを設定し
SaveWithDocument:=Trueを設定します
こんな感じ
If FName = False Then Exit Sub
With ActiveSheet.Shapes.AddPicture(Filename:=FName, _
LinkToFile:=False, SaveWithDocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0)
.LockAspectRatio = msoTrue
・
・
！　＃１様が回答されている内容と被りましたので参考程度で