dポイントプレゼントキャンペーン実施中!

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

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

Private Sub フォーム1_Change()

If フォーム1.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 フォーム1.ListIndex = 2 Then
・・・(3,4,5,と続く)
End If
End Sub

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

A 回答 (4件)

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



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

この回答への補足

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

補足日時:2007/04/11 09:03
    • good
    • 0
この回答へのお礼

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

お礼日時:2007/04/10 15:30

、「既にそこに貼り付けられてる画像は全部消して新しいのを貼る!」


であれば、下記で、一発です。


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

End Sub

この回答への補足

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

補足日時:2007/04/10 13:01
    • good
    • 1

#2 です。


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

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

画像を呼び出したらその直後に


Selection.ShapeRange.Name = Check_No'適当な番号
を実行して、

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

この回答への補足

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

補足日時:2007/04/09 23:41
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!