グループ化されたオートシェイプに対して、グループ解除せずに処理を行う
8679 ワード
やりたいこと
グループ化されたシェイプに対して、グループを解除せずに処理を行いたい。
特に、グループ化された図形がさらにグループ化されているようなケースを含めて処理したい。
参考: すべてのグループを解除する
以下のリンク先では、グループ化されたオートシェイプ・図形をすべてグループ解除するマクロです。
グループ化された図形がさらにグループ化されているようなケースでも、すべてグループ解除できます。
https://www.relief.jp/docs/018401.html
グループ化されたオブジェクトに対してループするマクロ
以下のマクロの「各Shapeに対する処理」というコメントに、各オートシェイプに対して行いたい処理を書けばよいです。
今回は、オートシェイプの名称をデバッグプリントに書き出すコードとしました。
Module1
Public Sub loopGroupedShape()
Dim shp As Shape
Dim gr_shp As Shape
Dim gr As Collection
Set gr = New Collection
For Each shp In ActiveSheet.Shapes
If shp.Type = msoGroup Then
gr.Add shp
Else
'各Shapeに対する処理
Debug.Print shp.Name
End If
Next
Do While gr.Count > 0
For Each gr_shp In gr
For Each shp In gr_shp.GroupItems
If shp.Type = msoGroup Then
gr.Add shp
Else
'各Shapeに対する処理
Debug.Print shp.Name
End If
Next
gr.Remove 1
Next
Loop
End Sub
使用例
マクロ実行対象
以下のようにグループ化された図形に対して、上記のマクロを実行します。
マクロ実行結果
イミディエイトウィンドウに、グループ化されたすべての図形の名前が表示されました。
このとき、マクロ実行後も、グループ化は解除されていません。
PowerPoint版
同様に、PowerPointでもGroup化した図形に対する処理ができます。
PowerPointの場合、ループの仕方を少し変えています。
Module1
Public Sub loopGroupedShape_PPT()
Dim sld As Slide
Dim shp As Shape
Dim gr_shp As Shape
Dim gr As Collection
Set gr = New Collection
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.Type = msoGroup Then
gr.Add shp
Else
'各Shapeに対する処理
Debug.Print shp.Name
End If
Next
Next
Do While gr.Count > 0
For Each gr_shp In gr
For Each shp In gr_shp.GroupItems
If shp.Type = msoGroup Then
gr.Add shp
Else
'各Shapeに対する処理
Debug.Print shp.Name
End If
Next
gr.Remove 1
Next
Loop
End Sub
Author And Source
この問題について(グループ化されたオートシェイプに対して、グループ解除せずに処理を行う), 我々は、より多くの情報をここで見つけました https://qiita.com/Umaremin/items/b7726fa7340c7f175e77著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .