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

xzl8833

修改需要选中当前幻灯片，这样就有个很大的问题了：在运行时，虽有有一行命令选中当前幻灯片，但是命令运行后，需要操作的幻灯片还没选中后面的语句就已经执行完了。比如我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

guojianlin1985

上附件吧。

xzl8833

原帖由 guojianlin1985 于 2011-6-9 15:37 发表
上附件吧。

大侠帮忙看看~~

guojianlin1985

你的附件跟没上一样，代码上边已经有了。真不知道你是不是猪头。

xzl8833

原帖由 guojianlin1985 于 2011-6-13 21:06 发表
你的附件跟没上一样，代码上边已经有了。真不知道你是不是猪头。

哥，我错了... ...我只不过希望有人帮我改善下代码而已嘛... 上个ppt有个鸡毛意义，随便用个几十页的ppt不一样的吗...

xzl8833

我的ppt显示的哪一页，那一页就正常执行
不知道怎么能实现：ActivePresentation.Slides(i).select完成后再执行后面得代码。
用由时间控制的不停doevents的循环cpu使用率很高，对前几页ppt似乎是有效果；用api sleep似乎把整个程序都给阻塞了，select都一并挂起不执行了，等时间到了仍旧是页面没选中，后面得代码不停的跑，一点效果都没有...
不知道大家还有什么比较好的思路

xzl8833

都去关注excel了吗...

zzj824

http://club.excelhome.net/thread-884097-1-1.html   你能帮我解决这个问题吗? 我很着急 也是改颜色的问题 但这是改图表颜色的