グループ化図形の中の選択図形の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」が取得できる
OK
今度はコピペした図形から取得してみる
コピーして
貼り付け
図形の名前は「グループ化 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
グループ化した2つの図形をクリックして表示を切り替えたい取得できないのはエクセルのバグらしいけど2013でも出るみたい…仕様なの?
https://social.msdn.microsoft.com/Forums/en-US/0be9c0cd-69d9-4815-abe6-5cb0ba890dfa?forum=vbajp
解決法はグループ化を解除してから再グループ化、とにかく一度でも再グループ化すれば正常な値が入るみたい
それにしてもまた再グループ化か!
手順は
- シート上すべての図形の中のグループ化図形を取得
- その中から選択図形を含むものを選択図形の名前で探す
- グループ化を解除してから再グループ化
これで後は普通に取得できるから
'選択図形の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
ParentGroupName2を実行すると
取得できた!
バグ?がなければ1行か2行で済むのにねえ
名前の数字が大きくなっているのは、再グループ化すると数字が1つ進むから
13も進んでいるのはいろいろ試していたから
関連記事
午後ツールその58、見出し付きテキストボックスの色変更 ( Windows ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14733745.html