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))

最終更新日時:2021-12-14 14:39

[スポンサードリンク]

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

「Shapesコレクション・Shapeオブジェクト」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.