Shapes GroupItems を使用してグループ化したシェイプにデータをセットする PowerPoint VBA

パワポでグループ化したテキストボックス・シェイプにデータをセットする、

そんな単体テストを行ってみたいと思います。
www.youtube.com
https://www.youtube.com/watch?v=XoNR5YrdtDQ

#PowerPointVBA #Shape #GroupItem #グループ化 #デバッグ

1.まずは、.Type タイプで判断

グループの頭、グループ化したシェイプか？
.Type で判断できます。

If ppShp.Type = msoGroup Then 'グループ化の判断
みたいな感じで、
.Typeの値がmsoGroupかで判断可能です。

2.グループ内のシェイプにたどり着く方法

なんて、いってるけど、シンブルで
.GroupItems
に
まとまっています。
これを知ってれば(視聴者様も今、知りましたよね)

あとは、いつもの
GroupItems.Count で数がわかったり
GroupItems.Item(1) で操作したり、
GroupItems(1)もアリだし
GroupItems("名前でアクセス")できたりします。

For Each shp In ppGShp.GroupItems  'グループのアイテムを回す

Next

GroupItems.Item = Shape なので、あとは、好きなように？

長いけど

ActivePresentation.Slides(4).Shapes("明細5").GroupItems("職業").TextFrame.TextRange.Text = "SE"

↑頭から、たどり着くこともできます。

3.グループ全体を非表示にできたりするので便利かな

いつもの、
グループshp.Visible = false
で、True可視,False不可視を制御できるので、
グループ化しておいた方がいいかなぁ。
※ひな型作るときの、コピーも楽だしね。

    '不可視にしてみる
    ppSLD.Shapes("明細4").Visible = msoFalse  'グループごと見えなくする
    ppSLD.Shapes("明細5").Visible = msoFalse  'グループごと見えなくする

4.終わりの挨拶

こんな感じで、グループ化されたシェイプを使えるので、
アレンジして、うまくコードを書いてください。

単体テストも終わったし、組み込まないとなぁ。
では、またぁ。

'グループにセットするテスト
Sub pp選択されたGroupを探る()

    Debug.Print "Selection.ShapeRange.Count =", ActiveWindow.Selection.ShapeRange.Count
    If ActiveWindow.Selection.ShapeRange.Count = 0 Then  '件数の判断
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If

    Dim ppShp As PowerPoint.Shape
    Set ppShp = ActiveWindow.Selection.ShapeRange(1) '選択一番目を代入
    
    'MsoShapeType 列挙 (Office)
    ' https://learn.microsoft.com/ja-jp/office/vba/api/office.msoshapetype
    Debug.Print "Shape Type=" & ppShp.Type
    If ppShp.Type <> msoGroup Then  'グループ化の判断
        MsgBox "Shapeがグループ化、されてないよ、確認してね"
        Exit Sub
    End If

    Debug.Print "GroupItems.Count=" & ppShp.GroupItems.Count
    Dim n As Long
    For n = 1 To ppShp.GroupItems.Count
        Debug.Print n, ppShp.GroupItems(n).Name
    Next
    
    Stop

End Sub

'グループにセットするテスト
Sub pp選択されたGroupを探る002()

    '3ページ目のスライドでテスト
    Dim ppSLD As PowerPoint.Slide
    Set ppSLD = ActivePresentation.Slides(3)
    
    Dim ppGShp As PowerPoint.Shape
    Set ppGShp = ppSLD.Shapes("明細2")  'グループのシェイプを代入
    
    Dim n As Long
    Dim shp As PowerPoint.Shape
    n = 1
    For Each shp In ppGShp.GroupItems  'グループのアイテムを回す
        If shp.HasTextFrame = True Then  'テキスト代入可能なら
            shp.TextFrame.TextRange.Text = n & shp.Name  'テストで数値と名前
        End If
        n = n + 1
    Next
    
    '不可視にしてみる
    ppSLD.Shapes("明細4").Visible = msoFalse  'グループごと見えなくする
    ppSLD.Shapes("明細5").Visible = msoFalse  'グループごと見えなくする

End Sub