指定したセルの範囲内にある図形（オートシェイプ）を削除するマクロを紹介します。
また、指定したオートシェイプの形状（楕円、長方形、など）だけを削除する方法と、
オートシェイプ以外（画像等）を削除する方法も紹介します。
指定セル範囲内のオートシェイプを全て削除する方法
A1:C3セルの範囲内にあるオートシェイプを削除するマクロを例にします。
マクロ実行結果は下図の通りです。
それではマクロのコードを紹介します。
Sub DeleteShapesInRange()
Dim shape As shape
Dim area As Range
Set area = Range("A1:C3") '削除したいセル範囲を指定する
For Each shape In ActiveSheet.Shapes
If Not Intersect(shape.TopLeftCell, area) Is Nothing Then
shape.Delete
End If
Next shape
End Subこのサンプルコードでは”TopLeftCell”でオートシェイプの範囲の起点を”左上の頂点”で指定しているので、オートシェイプの左上の頂点が指定したセルの範囲内に入っている場合、削除対象となります。
左上の頂点以外の部分が指定したセルの範囲内に入ってる場合は削除対象にはなりません。
今回のサンプルコードでは、下図のようにオートシェイプの左上の頂点がC3セルに入っているので、削除対象となってしまいます。
指定したオートシェイプの形状だけを削除する方法
指定したオートシェイプの形状（楕円、長方形など）だけを削除するマクロを紹介します。
今回は例として、にこちゃんマーク（msoShapeSmileyFace）だけを削除します。
全てのオートシェイプを削除するコードに「shape.AutoShapeType」の判定条件（IF構文）を追加するだけですが、Shapeオブジェクトからは数値で返ってくるため、削除したいオートシェイプの数値を調べる必要があります（VBEのヘルプから一覧参照可能です）。
今回削除するオートシェイプの形状は「msoShapeSmileyFace ＝ 17」と返ってきますので、shape.AutoShapeType =17の場合は削除するようにコード追加することで対応できます。
＜マクロ実行イメージ＞
＜コード＞
Sub DeleteShapesInRange()
Dim shape As shape
Dim area As Range
Set area = Range("A3:C3") '削除したいセル範囲を指定する
For Each shape In ActiveSheet.Shapes
If Not Intersect(shape.TopLeftCell, area) Is Nothing Then
'AutoShapeType = 17（msoShapeSmileyFace）の場合は削除する
If shape.AutoShapeType = 17 Then
shape.Delete
End If
End If
Next shape
End Sub＜マクロ実行後＞
このように、指定したオートシェイプのみ削除することが可能です。
オートシェイプ以外を削除する方法
オートシェイプ以外のオブジェクト（画像など）を削除する方法を紹介します。
オートシェイプか違うのかは「Shape.Type」を使用して判別します。
オートシェイプは「Shape.Type ＝ 1(定数)」ですので、1以外が返ってきた場合は削除するようにIF構文を追加することで対応できます。(VBEのヘルプから定数の一覧参が照可能です)
＜マクロ実行イメージ＞
＜コード＞
Sub DeleteShapesInRange()
Dim shape As shape
Dim area As Range
Set area = Range("A3:C3") '削除したいセル範囲を指定する
For Each shape In ActiveSheet.Shapes
If Not Intersect(shape.TopLeftCell, area) Is Nothing Then
'shape.Type = 1（オートシェイプ）以外の場合は削除する
If shape.Type <> 1 Then
shape.Delete
End If
End If
Next shape
End Sub＜マクロ実行後＞
このように、オートシェイプ以外を削除することができました。
定数そのほかのプロパティを判定条件にすることで応用ができます。
コメント