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

xzl8833 · 发表于 2011-6-9 15:18

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

上附件吧。

xzl8833 · 发表于 2011-6-13 17:30

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

大侠帮忙看看~~

guojianlin1985 · 发表于 2011-6-13 21:06

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

xzl8833 · 发表于 2011-6-13 23:52

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

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

xzl8833 · 发表于 2011-6-14 00:03

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

xzl8833 · 发表于 2011-6-19 16:45

都去关注excel了吗...

zzj824 · 发表于 2012-6-21 19:06

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

		自动登录	找回密码
密码			免费注册

[求助] VBA实现大量修改ppt中shape里字的颜色