エクセルVBAでセル番地を指定してオブジェクト名取得

質問

いつも大変おせわになり、ありがとうございます。
先日、エクセルシート内に貼り付けたオブジェクトの左上の角が位置するセル番地は、
ActiveSheet.Shapes("Check Box 1").TopLeftCell.Address
で求められることをご教示いただきましたが、逆に、セル番地を指定して、そこにオブジェクトの左上の角があるオブジェクト名を取得する方法はありますでしょうか？
ご教示いただければ幸いです。

回答No.1

onlyrom · ベストアンサー

参考程度ということで・・(^^;

Sub TEST()

　Dim myCell As Range
　Dim myShape As Shape

　Set myCell = Range("F5")

　For Each myShape In ActiveSheet.Shapes
　　　If myCell.Address = myShape.TopLeftCell.Address Then
　　　　　　MsgBox myShape.Name
　　　　　　Exit For
　　　End If
　Next myShape

End Sub

お礼

ありがとうございます。
オブジェクトのTopLeftCell.Addressを総なめして調べているのですね。
やはり、こうするしかないのでしょうか・・・。

回答No.4

Wendy02

こんばんは。Wendy02です。

私の書いた、ActiveSheet.CheckBoxes は、Excel 97 以降の隠しプロパティです。

Shapes は、ワークシート上のすべてのオブジェクトの上位コレクションとなりました。

フォーム・ツールは、チェックボックスなど個々のオブジェクトが、それぞれのコレクションとなります。（例：CheckBoxes) だから、そこから探し出す手法は、今のところ有効ですが、今後については、保証されたコードではないことだけは書いておきます。

本来は、onlyromさんがおっしゃるように、「Shapes でぐるぐる回す」のが正しいスタイルだと私も思います。隠しプロパティの扱いは、昔のコードとの互換性のために残っている方法だと思います。

ここ数年の新しい本には、隠しプロパティやメソッドは書かれていないはずです。私も、出来るけれど書かないように、ある程度は気をつけてはいます。

ただ、そんなことはどうでもないことかもしれませんが、コードとしては、上位のShapes コレクションでまわす場合は、それがフォームのCheckBox であるのか、いずれかの方法でチェックをする必要性はあるように思います。そうすると、結構、大げさになったり、汚くなったりするので、今回はやめました。

その場合、On Error Resume Next で、直接、FormControlType で一気に取る方法もありますが、ここでは、ちょっと格好が悪いので、あえて書くと、このような構造になるのではないかと思います。しかし、プライベートなら、どう書いてもかまいません。また、.name で取るというのは、本末転倒で、それは、うまくありません。

　For Each myShape In ActiveSheet.Shapes
　　　 If myShape.Type = msoFormControl Then
　　　　 If myShape.FormControlType = xlCheckBox Then
　　　　　　　 If myCell.Address = myShape.TopLeftCell.Address Then
　　　　　　　 MsgBox myShape.Name
　　　　　　Exit For
　　　　　End If
　　　　 End If
　　　 End If
　Next myShape

お礼

なんどもありがとうございました。勉強になります。

回答No.3

onlyrom

>オブジェクトのTopLeftCell.Addressを総なめして調べているのですね。
>やはり、こうするしかないのでしょうか・・・。

以下のことから、そうだと思います。

●RangeObjectにShapeを参照するプロパティがない
●ShapeのParent（コンテナ）は、Sheetである

そしてまた常連回答者のWendy02さんもループしてますから、、、

地道にShapesCollectionをくるくるしましょう。

お礼

はい、わかりました。
ありがとうございます。

回答No.2

Wendy02

こんにちは。

確かに、TopLeftCell で取れば良いようなんですが、前回お書きしたように、以外に、セルの位置を取りにくいので、以下のように範囲からオブジェクトをとるようにするのがふつうです。もしも、コントロールツールの場合は、OleObjects を使います。

''標準モジュール
'フォーム側

Sub FindObjects()
Dim myRng As Range
Dim cb As Variant
Set myRng = Range("E10")
For Each cb In ActiveSheet.CheckBoxes
　If Not Intersect(Range(cb.TopLeftCell, cb.BottomRightCell), myRng) Is Nothing Then
　　 MsgBox cb.Name
　　 Exit For
　End If
Next
Set myRng = Nothing
End Sub

お礼

Wendy02さん、いつもお世話様です。
ご丁寧にありがとうございました。