削除したオートシェイプがどのセルにあるかで判定して削除

マクロ講座 動画編 80回

削除したオートシェイプがどのセルにあるかで判定して削除

オートシェイプを範囲（位置するレンジ）で区別して削除する

動画版「マクロ講座」です。
オートシェイプの削除は一つずつ削除するか、またはまとめて削除するかの2通りしかないと思っていませんか？
今回の3行マクロ講座では、ExcelVBA のコードで、特定の範囲にあるオートシェイプを限定して削除したり、 楕円だけとかレクタングルだけとか種類によって限定して削除するというマクロを作成します。
このコードを知っているかどうかで、オートシェイプの使い勝手が飛躍的にアップすると言っても過言ではありません。 さらに、shape を確認しながら消していくということもできます。
（サンプルファイルは、こちらです。 オートシェイプを範囲で区別して削除する、サンプル80回）

マクロ動画　オートシェイプを範囲で区別して削除する

オートシェイプをマクロのコードを使って削除する

オートシェイプを作成していて、不要なオートシェイプや作りすぎたオートシェイプを削除したい時があります。
そのときに、どのように削除するかで悩んでしまいます。全部一度に削除してしまうのか、それとも一つずつ選択して削除するのかです。
残したいオートシェイプを除外して他を削除したい時のコードを考えてみます。

オートシェイプのタイプで削除するとか、オートシェイプの名前で削除するとか、いくつか方法は考えられます。
タイプを指定したり、名前を確認してマクロに書き込むのは面倒なことです。そこで、まず範囲にあるオートシェイプを削除するマクロを作りました。

こちらはIntersectメソッドを使っています。
If Not Intersect(rng, Range("C3:M3")) Is Nothing
Intersectメソッドの親オブジェクトはApplicationです。つまり IntersectメソッドはApplicationのメソッドです。
複数セル範囲の、重なっている部分のセル範囲を取得することが出来ます。

コードでは、図形のTopLeftCellを変数rngとし、一つ目の範囲として引数に入れています。
それと、Range("C3:M3")を指定して、重なっている部分があれば、図形を削除するという命令をしています。

Sub 範囲にあれば削除()
    Dim sh As Shape, rng As Range
    For Each sh In ActiveSheet.Shapes
        Set rng = sh.TopLeftCell
            If Not Intersect(rng, Range("C3:M3")) Is Nothing Then
            sh.Delete
            End If
    Next sh
End Sub

続いて、こちらはIntersectメソッドの2番目の引数にSelectionを設定しています。
というのも、範囲を限定してコードに書き込むのは、面倒だからです。

Sub 範囲にあれば削除2()
    Dim sh As Shape, rng As Range
    For Each sh In ActiveSheet.Shapes
        Set rng = sh.TopLeftCell
            If Not Intersect(rng, Selection) Is Nothing Then
            sh.Delete
            End If
    Next sh
End Sub

実行すると、範囲選択したSelectionに、図形のTopLeftCellがあれば、その図形は削除されてしまいます。

すべての図形を削除する

Sub allshapesdel()
    ActiveSheet.Shapes.SelectAll
    Selection.Delete
End Sub

Sub eachshapedel()
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes
        sh.Delete
    Next sh
End Sub