画像を削除するマクロが知りたい

質問

いつもお世話になっております。
別スレッドで「参照先ブックを開かずにコピーしたい」という投稿をしておりますが、その作業をしている同じブックでもう一つ実行したいことがあり、質問させていただきます。

現在、エクセルのマクロを使って、下記のようなプログラムを組んでいます。
(1)あるボタンを押すとフォームが出てくる
(2)フォームの中に画像のリストがあり、どれかを選んでクリックすると、ボタンのすぐ下のセルに画像が挿入される
VBAの構文でいうと以下のような内容です。

Private Sub フォーム１_Change()

If フォーム１.ListIndex = 0 Then
ChDir ThisWorkbook.Path
Workbooks.Open FileName:="BookA.xls"
Sheets("Sheet1").Select
Range("B2:H2").Copy
Windows("BookB").Activate
Sheets("Sheet2").Select
Range("B1").Select
ActiveSheet.Paste
Workbooks("BookA").Close
Windows("BookB").Activate
Else If フォーム１.ListIndex = 2 Then
・・・（3,4,5,と続く）
End If
End Sub

この要領で画像の貼付けを行い、一度挿入した画像が気に入らなくて別の画像に入れ替えたいという場合があるのですが、再度フォームボタンからリストを選択し直すと、新しく挿入した画像がその前に貼り付けられていた画像の上に重なる形で載ってきます。
この動作を繰り返すとどんどんブックの容量自体が重くなってしまうので、新しい画像を選択・挿入すると同時にその前に貼り付けられていた画像は削除される、というプログラムを組みたいです。
deleteとかclearとかいろんな構文を使って試してみましたが、どうしてもうまく行きません。
詳しい方のお知恵を拝借できれば幸いです。よろしくお願い致します。

回答No.2

KenKen_SP · ベストアンサー

エラー処理は省略してますが。。

Sub SampleProc()

　　' 例1）アクティブセルの場合
　　Call DelShapes(ActiveCell)
　　' 例2）ユーザーが選択したセル選択で指定する場合
　　Call DelShapes(Selection)
　　' 例3）Range で指定
　　Call DelShapes(Range("A1:C10"))

End Sub

' // 指定した Range の範囲と重なる位置にある Shape を削除
Private Sub DelShapes(ByVal Target As Range)

　　Dim Shp As Object
　　Dim r　 As Range

　　For Each Shp In Target.Parent.Shapes
　　　　Set r = Range(Shp.TopLeftCell, Shp.BottomRightCell)
　　　　If Not Intersect(r, Target) Is Nothing Then
　　　　　 Shp.Delete
　　　　End If
　　　　Set r = Nothing
　　Next
　　Set Target = Nothing

End Sub

お礼

とても丁寧な回答をいただきありがとうございます。
しかしエラーこそ出ないものの、残念ながら画像は消えず、目的達成できませんでした…。

補足

下記回答を投稿した後もあれこれやっていたら、構文自体に間違いは無いのに自分の単純なミスが原因で画像が消えなくなっていたことが判明しました。失礼しました…。
何とか解決しました！
本当にありがとうございました！！

回答No.4

Nayuta_X

、「既にそこに貼り付けられてる画像は全部消して新しいのを貼る！」
であれば、下記で、一発です。

Sub test()
ActiveSheet.Shapes.SelectAll
Selection.Delete

End Sub

補足

実はこれは既に試してありました。
そうすると、１シートにある画像、全てが消えてしまうんですよね…。
画面が真っ白になっちゃってびっくりした記憶があります。
シート上の、ある箇所（セル）に貼られてる画像だけ全て消したいんです。
Activesheetのところをactivecellにするということもやってみたんですが、これだとエラーが出てしまうし…。
どうしたものかと。

回答No.3

KenKen_SP

#2 です。
#2 の回答種類間違えた....「補足要求」ではなく「回答」です。

シート内の全ての Shape をチェックする力技なので図の数が
多いと処理速度は遅いかもしれません。
Application.ScreenUpdating = False を冒頭にでも追加
しておくと多少マシでしょう。

回答No.1

Nayuta_X

画像を呼び出したらその直後に
Selection.ShapeRange.Name = Check_No'適当な番号
を実行して、

ActiveSheet.Shapes(Check_No).Select
Selection.Delete
とすると　その画像だけを削除出来ます。
後は、あなたの腕次第です。

補足

ご回答ありがとうございます。
画像に一つ一つ名前を付ける方法は既に思いつきはしたんですが、何せリストが大量にあるため、できれば一つ一つ名前を付ける手間なく、「既にそこに貼り付けられてる画像は全部消して新しいのを貼る！」みたいなことができれば一番いいと思って質問を投稿させてもらったんです…。
やっぱり無茶なことなんでしょうか…？