PowerPoint VBA 【004】図形変更（グループ化）

2015/8/26 2015/11/11

グループ化されたオブジェクトの処理を追加しました。

フォント変更と同様に【003】ではグループ化されたオブジェクトが
対象になりません。

Sub PPT004()
    Dim sld As Slide
    Dim shp As Shape
    '***** 選択した全スライド
    For Each sld In ActiveWindow.Selection.SlideRange
      '***** 全シェイプ
        For Each shp In sld.Shapes
            '*** グループ化されているオブジェクト
            If (shp.Type = msoGroup) Then
                Call grp_proc(shp)
            Else
                'オートシェイプの処理
                Call shape_proc(shp)
            End If
        Next shp
    Next sld
End Sub

全スライドを対象にするには

    '***** 全スライド
    For Each sld In ActivePresentation.Slides

グループ化の処理です。
グループ化されているオブジェクトがなくなるまで
繰り返します。

Sub grp_proc(shp As Shape)
    '***** グループ化されている場合の処理 *****
    Dim grp As Shape
    '*** グループ内のオブジェクト分繰り返す
    For Each grp In shp.GroupItems
        'さらにグループ化されている
        If (grp.Type = msoGroup) Then
            Call grp_proc(grp)
        Else
            'オートシェイプの処理
            Call shape_proc(grp)
        End If
    Next grp
End Sub

オブジェクト変更の処理です。
ここで実際の更新処理を行ってます。

Sub shape_proc(shp As Shape)
    '***** シェイプの処理 *****
    If (shp.Type = msoAutoShape) Then
        '正方形／四角形で枠線が黒色
        If (shp.AutoShapeType = msoShapeRectangle) And _
           (shp.Line.ForeColor.RGB = RGB(0, 0, 0)) Then
            '枠線を赤色に変更
            shp.Line.ForeColor.RGB = RGB(255, 0, 0)
        End If
    End If
End Sub

オブジェクト変更部分、とグループ化の処理は
同じ処理を何度か書く必要があるので、ルーチン化しました。
構造化プログラミングです。

グループ化の処理は再帰化ロジックとなってます。
（自分で自分をコールしてます）