グループ化図形の中の図形のTopLeftCell取得方法とコピペで消えてしまうParentGroupの取得

グループ化図形の中の選択図形のTopLeftCellを取得したい

図形1から3までの文字を入れた図形3つをグループ化して、その中の図形3を選択した状態

この図形のTopLeftCell(左上にあるセル)を取得したい場合

期待するのはB5セル

普通に書いて

Sub test3()
Dim s As Shape
Set s = Selection.ShapeRange(1) '選択図形取得
Dim r As Range
Set r = s.TopLeftCell 'セル取得
MsgBox s.TextFrame2.TextRange.Text & _
"のTopLeftCellのアドレスは" & vbNewLine & ad
End Sub

これを実行すると

A2っていわれる、一昨日はこれで困っていた

どうやらグループ化図形の左上にあるセルが返ってくるみたい

これはエクセル2007より新しいものでもこうなのかしら？

いろいろ試してさっきできたのが

'グループ化図形の中の選択図形のTopLeftCellを取得するマクロ

Sub グループ化図形の中の選択図形のTopLeftCell()
'選択図形取得
Dim s As Shape
Set s = Selection.ShapeRange(1)

'グループ化図形のGroupItemsを取得
Dim gs As GroupShapes
Set gs = s.ParentGroup.GroupItems

s.ParentGroup.Ungroup 'グループ化解除
Dim r As Range
Set r = s.TopLeftCell 'セル取得

'再グループ化はIndexか名前どちらでもいい
' gs.Range(1).Regroup 'Indexの1を使って再グループ化
gs.Range(s.Name).Regroup '選択図形の名前を使って再グループ化

MsgBox s.TextFrame2.TextRange.Text & _
"のTopLeftCellのアドレスは" & vbNewLine & r.Address
End Sub

期待通り！

処理内容は単純で

一度グループ化を解除する

TopLeftCellを取得

再グループ化する

これだけ

解決できないと思ったけどなんとかなった問題

グループ化図形をコピペかCtrl+Dで複製した中の図形のParentGroupは空白になってしまうので取得できない

コピペじゃない元のグループ化図形

名前はグループ化 99

ここから

中の図形3(正方形/長方形 75)を選択した状態にして

ParentGroupの名前を表示するマクロ↓を実行

'選択図形のParentGroupを取得するマクロ

Sub ParentGroupName()
On Error Resume Next
Dim s As Shape
Set s = Selection.ShapeRange(1) '選択図形
Dim pg As Shape
Set pg = s.ParentGroup 'ParentGroup図形取得

'ParentGroup図形の名前を表示
Dim str As String
str = pg.Name
MsgBox "グループ化図形の名前： " & str
End Sub

グループ化図形の名前「グループ化 99」が取得できる

今度はコピペした図形から取得してみる

コピーして

貼り付け

図形の名前は「グループ化 100」になった

同じように中の図形を選択した状態で

マクロを実行

「グループ化 100」って表示されればいいけど

取得できてない！

マクロを一時停止して中を見てみると

無いのよねえ、なんで？

ParentGroupだけじゃなくてParentも無い

取得できないと、さっきのグループ化の解除や再グループ化もできないし、TopLeftCellも取得できないことになる(´・ω・`)

なのでコピペや複製した見出し付きテキストボックスは

この枠の中のボタンはほとんど無効になる

と思っていたけど

ここまできてググってみたら解決方(？)が見つかった

Excel VBAでグループ化した図形についてExcel2010でオートシェー... - Yahoo!知恵袋
 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12147295652

『シェイプをコピーしたものが動作しない。Applicat』（setcom）エクセル Excel [エクセルの学校]
http://www.excel.studio-kazu.jp/kw/20150410130248.html

グループ化した２つの図形をクリックして表示を切り替えたい
https://social.msdn.microsoft.com/Forums/en-US/0be9c0cd-69d9-4815-abe6-5cb0ba890dfa?forum=vbajp

取得できないのはエクセルのバグらしいけど2013でも出るみたい…仕様なの？

解決法はグループ化を解除してから再グループ化、とにかく一度でも再グループ化すれば正常な値が入るみたい

それにしてもまた再グループ化か！

手順は

シート上すべての図形の中のグループ化図形を取得
その中から選択図形を含むものを選択図形の名前で探す
グループ化を解除してから再グループ化

これで後は普通に取得できるから

'選択図形のParentGroupを取得するマクロ2
'対象のグループ化図形だけを解除→再グループ化
Sub ParentGroupName2()
    On Error Resume Next
    Dim ts As Shape
    Set ts = Selection.shaperange(1)
    Dim pg As Shape
    Set pg = ts.ParentGroup '取得！
    'ParentGroupが取得できなかったとき
    If pg Is Nothing Then
        Dim gs As GroupShapes
        Dim s As Shape
        For Each s In ActiveSheet.Shapes 'シート上すべての図形
            If s.Type = msoGroup Then 'グループ化図形なら
                For i = 1 To s.GroupItems.Count
                    If s.GroupItems(i).Name = ts.Name Then
                        Set gs = s.GroupItems '中の図形取得
                        s.Ungroup 'グループ化を解除
                        '中の図形の名前で再グループ化
                        gs.Range(ts.Name).Regroup
                        Set pg = ts.ParentGroup '取得！
                        Exit For '見つかったら抜ける
                    End If
                Next
                If Not pg Is Nothing Then Exit For '見つかったら抜ける
            End If
        Next
    End If
    
    MsgBox "グループ化図形の名前： " & pg.Name
End Sub