エクセル VBA 特定の範囲内に一部分でも入っていたら、そのオートシェイプを削除

オートシェイプの削除をVBAでしたいのですが

' セル範囲の座標取得
With Range("AR47:CI56")
lngTop = .Top
lngLeft = .Left
lngBottom = .Top + .Height
lngRight = .Left + .Width
End With
' アクティブシートの図形列挙
For Each objShape In ActiveSheet.DrawingObjects
' 範囲内にあるかチェック
With objShape
If lngTop <= .Top And lngLeft <= .Left And _
lngBottom >= .Top + .Height And lngRight >= .Left + .Width Then
' 範囲内にあれば削除
.Delete
End If
End With
Next

現在のマクロだと指定セル範囲の中に全部入っているものしか削除されません。

これを、指定セル内に一部でも入っていたら削除

にしたいです。

ご教授お願いします。

No.2 ベストアンサー 回答者： tom04 回答日時： 2018/10/02 18:01

こんばんは！

一例です。

Sub Sample1()
　Dim mySp As Shape, myRng As Range
　　Set myRng = Range("AR47:CI56")
　　　For Each mySp In ActiveSheet.Shapes
　　　　If Not Intersect(Range(mySp.TopLeftCell, mySp.BottomRightCell), myRng) Is Nothing Then
　　　　　mySp.Delete
　　　　End If
　　　Next mySp
End Sub

こんな感じではどうでしょうか？

※　かなり前に他の方が回答されていたのをそのまま使わせていただきました。m(_ _)m

この回答へのお礼

お礼が遅くなり申し訳ありません。
ありがとうございます！！

思った通りの動きが出来ました！

お礼日時：2018/10/03 09:04

No.1 回答者： fujillin 回答日時： 2018/10/02 17:17

こんにちは

例えばX軸について、セル範囲の座標ををX1,X2、図形の座標をx1,x2とした場合

1）一部重なっている場合
　X1 < x1 < X2　または　X1 < x2 < X2

2)包含している場合
　x1 < X1 < X2 < x2 (逆の包含は1）で検出可能）

について調べれば良いので、これをX,Y方向の両方についてチェックすれば良いのではないでしょうか？

※ 2）のチェックの代わりに、Xとxを入れ替えて、1）の方法でチェックするのでも検出できるはずと思います。

この回答へのお礼

お礼が遅くなり申し訳ありません。

わかりやすい解説ありがとうございます。
参考に作ってみます。

お礼日時：2018/10/09 13:55