user_jxuwo 发表于 2016-4-12 13:24:39

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

wyyjesse 发表于 2016-4-12 14:43:37

上附件吧。

a64048596 发表于 2016-4-12 15:01:45

大侠帮忙看看~~

user_abdid 发表于 2016-4-12 15:29:30

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

brader 发表于 2016-4-12 15:41:57

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

user_jcwfm 发表于 2016-4-12 16:10:18

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

user_qqnrs 发表于 2016-4-12 17:30:40

::( 都去关注excel了吗...

user_biazqbxq 发表于 2016-4-12 17:57:19

你能帮我解决这个问题吗? 我很着急 也是改颜色的问题 但这是改图表颜色的
页: [1]
查看完整版本: VBA实现大量修改ppt中shape里字的颜色