VBA实现大量修改ppt中shape里字的颜色

修改需要选中当前幻灯片，这样就有个很大的问题了：在运行时，虽有有一行命令选中当前幻灯片，但是命令运行后，需要操作的幻灯片还没选中后面的语句就已经执行完了。比如我ppt显示的是第一页，那么程序执行完毕之后，只有第一页的颜色被修改了，后面得都没动。我试着加了个延时，一个是用循环控制时间，CPU使用率100%；另外一个是用api sleep，根本没效果，可能是sleep的时候ppt已经被阻塞...最后我是在选中要操作的幻灯片后设置了一个断点，手动控制....好麻烦....
不知道各位大侠有没有什么好办法。
Sub aa()
    Dim OS As Slide
    Dim OA As String
    Dim n1 As Integer
    Dim n2 As Integer
    Dim i1 As Integer
    Dim i2 As Integer
    On Error Resume Next
    n1 = ActivePresentation.Slides.Count
    For Each OS In ActivePresentation.Slides
        Debug.Print i1
        OS.Select‘断点在这个后面
        n2 = OS.Shapes.Count ' ActivePresentation.Slides(i1).Shapes.Count
        For i2 = 1 To n2
            ActiveWindow.Selection.SlideRange.Shapes(i2).Select
            ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
            ActiveWindow.Selection.TextRange.Font.Color.SchemeColor = ppShadow
            With ActiveWindow.Selection.ShapeRange
                .Fill.Transparency = 0#
                .Line.Visible = msoTrue
                .Line.ForeColor.SchemeColor = ppShadow
                .Line.BackColor.RGB = RGB(255, 255, 255)
            End With
            ActiveWindow.Selection.ShapeRange.GroupItems(Index:=2).TextFrame.TextRange.Select
            ActiveWindow.Selection.TextRange.Font.Color.SchemeColor = ppShadow
        Next
    Next
End Sub

上附件吧。