すべての図形(オブジェクト)を削除する

すべての図形オブジェクトを一括で削除するコードを紹介します。

特定のシートのオブジェクトをすべて削除する

図形(オートシェイプ)だけでなく、テキストボックスやグラフなど、
とにかくオブジェクトを全部削除したいという場合は、
以下のコードで簡単に実行できます。

ActiveSheet.DrawingObjects.Delete

　
この処理はシートを指定できますので、

Worksheets("○○").DrawingObjects.Delete

と、指定シートのすべてのオブジェクトを削除することができます。

ブック内のすべてのオブジェクトを削除する

ブック内からすべてのオブジェクトを削除する場合は、
上記のコードをすべてのシートに実行すればOKです。

シート番号を1からシートの数だけループして、

Dim 指定ブック As Workbook
Set 指定ブック = Workbooks("○○.xlsx")

Dim シートNo As Long
For シートNo = 1 To 指定ブック.Worksheets.Count
    Worksheets(シートNo).DrawingObjects.Delete
Next

と書いてもいいですし、

For Eachステートメントでブック内のすべてのシートをループして

Dim 指定ブック As Workbook
Set 指定ブック = Workbooks("○○.xlsx")

Dim ws As Worksheet
For Each ws In 指定ブック.Worksheets
    ws.DrawingObjects.Delete
Next

と処理してもOKです。

グラフは消さない など例外を設定する

上記のコードは、オブジェクトであれば何でも消してしまいます。

例えば「グラフは残す」処理をしたい場合は、
For Each文ですべてのオブジェクトをループして、
消す/消さないを判定することになります。

Sub グラフ以外のすべての図形を削除する(対象シート As Worksheet)

    Dim 図形オブジェクト As Shape
    For Each 図形オブジェクト In 対象シート.Shapes
        
        If 図形オブジェクト.Type <> msoChart Then
            図形オブジェクト.Delete
        End If

    Next
End Sub

ワークシート.Shapesでそのシート内のすべての図形オブジェクトを取得できます。

それをFor Eachで順番にループして、
Shapeオブジェクト.Typeによって処理を行うか都度判定すればいいわけですね。

今回のコードはTypeがmsoChartでないもの、
すなわちグラフではないものを削除するコードですので、

Call グラフ以外のすべての図形を削除する(ActiveSheet)

を実行してみると、グラフだけが残っていることが確認できます。

どのオブジェクトがなんのTypeかは、

と、入力時に出てくる選択肢から適当に選んで試してみるのが早いです。

わからなかったらShapeオブジェクト.Typeで検索してみてください。

他には、

If 図形オブジェクト.Top > 28.5 Then

など、位置で削除するかを判定することもできます。

マクロのボタンだけ残すなどオブジェクトの種類が特定しづらいときには、
こちらの方法も検討してみてください。

さて基本はこれでいいのですが、実はこのコードはとんでもない罠が潜んでいます。

なんとワークシート.Shapesの中には、
セルの入力規則で設定したドロップダウンリストの「▼」が含まれています。

上記のコードを実行すると入力リストの▼が消えて、
リストから選んで入力することができなくなってしまいます。

とんでもない仕様ですよね。

ドロップダウンリストにはそれを表すTypeがないため、
この罠を回避するには以下のように書く必要があります。

Sub グラフ以外のすべての図形を削除する(対象シート As Worksheet)

    Dim 図形オブジェクト As Shape
    For Each 図形オブジェクト In 対象シート.Shapes
        If Not 図形オブジェクト.Name Like "Drop Down *" Then
        
            If 図形オブジェクト.Type <> msoChart Then
                図形オブジェクト.Delete
            End If

        Next
    Next
End Sub

ドロップダウンリストはオブジェクトの名前が「Drop Down 〇」なので、
Shapesオブジェクト.Nameの前方が「Drop Down」かを判定し、
そうでないものだけ処理をするループを書く必要があります。

この罠には十分に気を付けてください。
詳しくはこちらをどうぞ。

www.limecode.jp

ツールバーなどに設置して便利マクロとして使う

この処理は「何かのマクロに組み込む」ことよりも、
作業中のシートで実行したいことが多いかもしれません。

そんな時は、

Sub アクティブシートの全図形を削除する
    ActiveSheet.DrawingObjects.Delete
End Sub

と、単体のマクロにして個人用マクロブックなどに保存し、
ツールバーやリボンに設置するのが便利です。

が、実行型の便利マクロ全般に言えるのですが、
「元に戻す」が使えないという弱点があります。

なので、便利マクロにはこの一歩手前の「すべての図形を選択」を登録しておき、
削除は「選択された図形を眺めてからDeleteキー」がおすすめです。

Deleteキー1回なのでほとんど手間は変わりませんし、確認ができますし、
やっちまっても「元に戻す」が使えますからね。
　

Sub すべての図形を選択する()
    On Error Resume Next
    ActiveSheet.Shapes.SelectAll
End Sub

便利マクロとしては、こちら↑をご利用ください。