選択中の図形(Shape)を処理する - ShapeRange

ソースコード

Sub 選択中の図形に処理を実行する()

    ' 選択しているのが図形でなければExit
    On Error Resume Next
    Dim 選択ShapeRange As ShapeRange
    Set 選択ShapeRange = Selection.ShapeRange
    If 選択ShapeRange Is Nothing Then Exit Sub
    On Error GoTo 0

    ' Selection内の全Shapeをループ
    Dim シェイプ As Shape
    For Each シェイプ In 選択ShapeRange
    
        ' 処理のサンプル①：テキストを持つ図形だけを削除
        If シェイプ.TextFrame2.HasText Then
            シェイプ.Delete
        End If
    
        ' 処理のサンプル②：グラフ以外の図形を削除
        If シェイプ.Type <> "Chart" Then
            シェイプ.Delete
        End If
    
    Next

End Sub

解説

シート上の図形に対して処理を実行するには、
通常はShapeオブジェクトのプロパティ/メソッドを実行します。

シート上の全図形は「Worksheetオブジェクト.Shapes」で取得できますので、
以下の処理であれば比較的ストレートなコードで記述することが可能です。

▼ シート上にあるすべての図形をShape型として取得

Dim シェイプ As Shape
For Each シェイプ In Worksheets("○○").Shapes

　
▼ 特定の名前の図形をShape型として処理

Dim シェイプ As Shape
Set シェイプ = Worksheets("○○").Shapes("TextBox 1")

しかし問題はSelection内の図形をShape型として取得したい場合で、
図形を選択していてもSelectionはShapesコレクションになりません。

' ↓こう書くことはできない（詳細は後述）
Dim シェイプ As Shape
For Each シェイプ In Selection

　
この対策として使用するのがShapeRangeプロパティで、
このプロパティは様々な図形オブジェクトをShapeのリストにしてくれます。

' ↓これでOK
Dim シェイプ As Shape
For Each シェイプ In Selection.ShapeRange

　
厳密にはちょっと違うのですが、
「ShapeRangeは図形ObjectをShapesコレクションに変換するプロパティ」
と捉えるとわかりやすいかもしれません。

単独の図形も要素1つのShapesコレクションのようにしてくれるので、
For Each文がそのまま動いてくれるのもありがたい仕様ですね。

ついでにこのプロパティは選択しているのが図形かを判定するのにも使え、
前述のこのコードでSelectionがRangeなどの場合を除外できます。

' 選択しているのが図形でなければExit
On Error Resume Next
Dim 選択ShapeRange As ShapeRange
Set 選択ShapeRange = Selection.ShapeRange
If 選択ShapeRange Is Nothing Then Exit Sub
On Error GoTo 0

　
SelectionのShape化、Selectionの対象判定共に必須の処理ですので、
選択図形を扱う際はShapeRangeプロパティの仕様をしっかり習得しておきましょう。

おまけ：Selectionの仕様とDrawingObjects型について