그룹화된 자동 모양에 대해 그룹 해제하지 않고 처리

하고 싶은 일

그룹화 된 모양에 대해 그룹을 해제하지 않고 처리를 수행하고 싶습니다.
특히, 그룹화된 도형이 더 그룹화되는 경우를 포함하여 처리하고자 한다.

참고: 모든 그룹 해제

다음의 링크처에서는, 그룹화 된 오토셰이프·도형을 모두 그룹 해제하는 매크로입니다.
그룹화된 도형이 더 그룹화된 경우에도 모두 그룹을 해제할 수 있습니다.
htps //w w. 레에 f. jp / cs / 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

사용 예

매크로 실행 대상

다음과 같이 그룹화된 도형에 대해 위의 매크로를 실행합니다.

계층 1


계층 2


계층 3


계층 4

매크로 실행 결과

즉각적인 창에 그룹화된 모든 도형의 이름이 표시되었습니다.
이 때 매크로 실행 후에도 그룹화는 해제되지 않습니다.

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