Excelシートに配置された図形が特定の範囲内にある場合、その図形を削除したいことがあるかもしれません。今回は、指定されたセル範囲に重なっている図形を自動的に削除するVBAコードを紹介します。
コードの概要
以下のコードは、指定されたセル範囲 (Slc
) に重なっている図形を削除する手順を示しています。
Sub DeleteShapesInRange()
Dim Slc As Range
Dim Shp As Shape
Dim A As Range
' 図形を削除したいセル範囲を指定
Set Slc = ActiveSheet.Range("A1:BE44")
' シート上のすべての図形をループ処理
For Each Shp In ActiveSheet.Shapes
' 図形が重なっているセル範囲を取得
Set A = ActiveSheet.Range(Shp.TopLeftCell, Shp.BottomRightCell)
' 図形が指定範囲に重なっている場合、その図形を削除
If Not Intersect(A, Slc) Is Nothing Then
Shp.Delete
End If
Next Shp
End Sub
コードの詳細解説
1. 削除対象範囲の指定
Set Slc = ActiveSheet.Range("A1:BE44")
Slc
: この変数に削除したい図形が重なっているセル範囲を指定します。この例ではA1:BE44
が指定範囲となります。
2. 図形の位置を確認
Set A = ActiveSheet.Range(Shp.TopLeftCell, Shp.BottomRightCell)
Shp.TopLeftCell
: 図形の左上隅が重なっているセルを取得します。Shp.BottomRightCell
: 図形の右下隅が重なっているセルを取得します。- これにより、図形が占有するセル範囲 (
A
) を特定します。
3. 指定範囲内の図形を削除
If Not Intersect(A, Slc) Is Nothing Then
Shp.Delete
End If
Intersect(A, Slc)
: 図形が指定したセル範囲 (Slc
) と重なっているかを確認します。Intersect
関数は、2つの範囲が重なっている部分を返します。- 重なっている場合は
Shp.Delete
で図形を削除します。
実用例
例えば、月次報告書などで特定の範囲にのみ図形が必要で、それ以外の場所に存在する図形を自動的に削除したい場合に、このマクロを使用できます。図形の削除範囲を柔軟に設定することで、任意の範囲に適用可能です。
例: シートの上部にだけ図形を残し、それ以外の部分をクリアする
Sub ClearShapesOutsideHeader()
Dim Slc As Range
Dim Shp As Shape
Dim A As Range
' シートの上部範囲(例: A1からZ10)を指定
Set Slc = ActiveSheet.Range("A1:Z10")
' シート上のすべての図形をループ処理
For Each Shp In ActiveSheet.Shapes
' 図形が重なっているセル範囲を取得
Set A = ActiveSheet.Range(Shp.TopLeftCell, Shp.BottomRightCell)
' 図形が指定範囲に重なっていない場合、その図形を削除
If Intersect(A, Slc) Is Nothing Then
Shp.Delete
End If
Next Shp
End Sub
このコードでは、A1:Z10
の範囲に含まれない図形を削除します。
まとめ
このVBAコードを使用することで、Excelシートの特定のセル範囲内にある図形を簡単に削除することができます。特に、不要な図形を整理したい場合や、テンプレートから特定範囲外の図形を除去したい場合に便利です。ぜひ、あなたのプロジェクトで活用してみてください。
こういうの実行してなんか大事な図形が消えた気がする時あるよねー
ではまたー
コメント