VBAでexcelのグループ化された図形から子供図形のテキストを取り出すには？

質問

質問タイトルのとおりですが、ＥＸＣＥＬ図形において、グループを解除することなく、グループ化されたままで子供図形の中の文をＶＢＡで取り出したり変更するのは不可能なのでしょうか？
GroupItems→item1→drawingobject→textとたどって行きましたがアクセス出来ないプロパティのようです。

回答No.4

papayuka

こちらでもExcel2003のマシンでやってみましたが、おっしゃる通りダメでした。
Excel97、Excel2000はOKのようで、仕様が変わったようですね。

回答No.3

papayuka

であればお役に立てません。
こちらでは問題なく動作しますので。
（但し、グループ化したシェイプ同士をグループ化した場合を除く）

【検証内容】
　環境：Excel2000
　１）適当なオートシェイプを作り、テキストの追加をしてから適当な文字を書く。
　２）上記を何度か繰り返して複数のオートシェイプを作りグループ化。
　３）マクロを実行

お礼

会社のexcel2000ではＯＫでした。
もう一台のexcel2002ではＮＧでした。

補足

微妙なところなのですね。私の自宅のＰＣはExcel2003です。会社のPCでやってみて報告します。

回答No.2

papayuka

> どうも私の環境では(1)で型が違うと怒られてしまいます。

あの、、、
ここまで書き換えておいて「俺の環境じゃ動かねー」って言われても、、、（^^;
私のサンプルでも動きませんか？

普通のオートシェイプとテキスト枠を持つオートシェイプで処理を分ける必要があるようです。
この判定方法も良く解らなかったので、サンプルでは On Error Resume Next で逃げてます。
下記でセルコメントも拾ってきます。

Sub aaa()
Dim sh As Shape
　On Error Resume Next
　For Each sh In ActiveSheet.Shapes
　　If sh.Type = msoGroup Then
　　　 For i = 1 To sh.GroupItems.Count
　　　　　 Debug.Print sh.GroupItems(i).TextFrame.Characters.Text
　　　 Next i
　　Else
　　　 Debug.Print sh.TextFrame.Characters.Text
　　End If
　Next sh
End Sub

知識のある方のようですし、再帰等についてはご自身でご検討下さい。

補足

すみませんでした。全くそのままでやって駄目だったので色々調べているうちにコードの形が変わって行ったんです。
上のコードもそのままでやってみましたが、最初何も出ないので、on　errorを外してやってみたところ、次のところで「型が一致しません」というエラーになってしまいます。
Debug.Print sh.GroupItems(i).TextFrame.Characters.Text

回答No.1

papayuka

Shape を単純にグループ化した物なら下記で取得出来ました。
ただ、グループ化した Shape 同士をグループ化したようなケースだと上手く取得出来ないようで、この回避法は解りません。

Sub Test()
Dim sh As Shape
　On Error Resume Next
　For Each sh In ActiveSheet.Shapes
　　If sh.Type = msoGroup Then
　　　 For i = 1 To sh.GroupItems.Count
　　　　　 MsgBox sh.Name & " : " & _
　　　　　　　sh.GroupItems(i).TextFrame.Characters.Text
　　　 Next i
　　End If
　Next sh
End Sub

お礼

教えていただいた方法を検証してみましたが、どうも私の環境では(1)で型が違うと怒られてしまいます。
Sub Test()
Debug.Print vbNewLine & "------------------------"
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Type = msoGroup Then
For i = 1 To sh.GroupItems.Count
Dim sh2 As Shape
Set sh2 = sh.GroupItems(i)
Debug.Print sh2.Name, "タイプ" & sh2.Type;
txt = " 内容:" & sh2.TextFrame.Characters.Text<----(1)
Debug.Print txt
Next i
Else
Debug.Print sh.Name, "タイプ" & sh.Type;
If sh.Type = msoAutoShape Then
Debug.Print " 内容:" & sh.TextFrame.Characters.Text
ElseIf sh.Type = msoTextBox Then
Debug.Print " 内容:" & sh.TextFrame.Characters.Text
Else
Debug.Print "　-"
End If
End If
Next sh
End Sub

補足

charactersというのがあったのでっすか！気がつかなかった。それで行けるならこれをfunctionにして再帰コーディングすれば全部解けて行けるのではないでしょうか？？？？