Home » エクセルマクロ・Excel VBAの使い方 » Shapesコレクション・Shapeオブジェクト » Shapeの存在するセル範囲を取得してオブジェクト変数に

Shapeの存在するセル範囲を取得してオブジェクト変数に

対象：Excel2007, Excel2010, Excel2013, Windows版Excel2016

「図形の配置されているセル範囲をオブジェクト変数にセット」
という検索で、このサイト・インストラクターのネタ帳へのアクセスがありました。

詳細はわかりませんが、Excel VBA（Visual Basic for Applications）で、Shapeの存在するセル範囲を取得して、オブジェクト変数にセットするには、どのようなコードを書けばいいのかを探している方による検索でしょうか。

1個のShapeの存在するセル範囲を取得するサンプルマクロ

以下のようなマクロで、1個のShapeが存在するセル範囲を表すRangeオブジェクトを取得して、オブジェクト変数にセットできます。

Sub 図形の存在するセル範囲をオブジェクト変数に_単独図形()

　Dim rng As Range

　With ActiveSheet.Shapes(1)
　　Set rng = Range(.TopLeftCell, .BottomRightCell)
　End With

　MsgBox rng.Address(False, False)

End Sub

上記のマクロを実行すると、アクティブシート上の1つ目のShapeの存在するセル範囲のアドレスがメッセージボックスに表示されます。

Shapeオブジェクトの、TopLeftCellプロパティでShapeの左上にあるセルを表すRangeオブジェクトを、

Shapeの存在するセル範囲を取得してオブジェクト変数に

BottomRightCellプロパティでShapeの右下にあるセルを表すRangeオブジェクトを、

Shapeの存在するセル範囲を取得してオブジェクト変数に

それぞれ取得できます。

この、Shape.TopLeftCellプロパティとShape.BottomRightCellプロパティで取得した2つのRangeオブジェクトを、Rangeプロパティの引数に指定することで、1個のShapeが存在するセル範囲を表すRangeオブジェクトを取得して、そのRangeオブジェクトをオブジェクト変数・rngにセットしています。
　With ActiveSheet.Shapes(1)
　　Set rng = Range(.TopLeftCell, .BottomRightCell)

複数のShapeが存在するセル範囲を取得するサンプルマクロ

複数のShapeが存在しているときに、そのすべてのShapeが存在するセル範囲を表すRangeオブジェクトを取得してオブジェクト変数にセットするなら、以下のようなマクロでしょうか。

Sub 図形の存在するセル範囲をオブジェクト変数に()

　Dim shp As Shape
　Dim rng As Range
　Dim row_a As Long　' 図形の存在する一番上の行番号
　Dim col_a As Long　' 図形の存在する一番左の列番号
　Dim row_z As Long　' 図形の存在する一番下の行番号
　Dim col_z As Long　' 図形の存在する一番右の列番号

　row_a = Rows.Count
　col_a = Columns.Count
　row_z = 1
　col_z = 1

　For Each shp In ActiveSheet.Shapes
　　With shp
　　　' 最も左上のセルの列番号・行番号を探す
　　　With .TopLeftCell
　　　　If .Row < row_a Then row_a = .Row
　　　　If .Column < col_a Then col_a = .Column
　　　End With
　　　' 最も右下のセルの列番号・行番号を探す
　　　With .BottomRightCell
　　　　If .Row > row_z Then row_z = .Row
　　　　If .Column > col_z Then col_z = .Column
　　　End With
　　End With
　Next shp

　Set rng = Range(Cells(row_a, col_a), Cells(row_z, col_z))

　MsgBox rng.Address(False, False)

End Sub

上記のマクロを実行すると、複数のShapeが存在していたときに、それらすべてのShapeを含むセル範囲のアドレスが、メッセージボックスに表示されます。

アクティブシート上の全Shapeに対してFor Each～Nextループを回して、
　For Each shp In ActiveSheet.Shapes

最も上の行番号・最も左の列番号と、
　　With shp
　　　With .TopLeftCell
　　　　If .Row < row_a Then row_a = .Row
　　　　If .Column < col_a Then col_a = .Column

最も下の行番号・最も右の列番号を取得して、
　　　With .BottomRightCell
　　　　If .Row > row_z Then row_z = .Row
　　　　If .Column > col_z Then col_z = .Column

CellsプロパティとRangeプロパティを組み合わせてセル範囲を表すRangeオブジェクト取得して、オブジェクト変数・rngにセットしています。
　Set rng = Range(Cells(row_a, col_a), Cells(row_z, col_z))