求各位大佬帮忙写一个批量添加简单动画的VBA（有图，有文档）

2337359709

如图，希望给带有【正确答案】和【答案解析】的这两段文字加上淡出的动画，目前有600多页ppt要加这种动画，未来还会有很多，求各位大佬们帮忙写一个VBA，谢谢了。 求助.rar (39.45 KB, 下载次数: 21)

2013-7-31 16:17 上传

点击文件名下载附件

csnAlex

没找到方法把文本框中的特定段落加上效果，换了另外一种思路，先把整个文本框设置“渐入”效果，再把不符合条件的效果从时间线的主序列中删掉。
注意，如果页面上已经存在的自定义动画会被删除。

[code=vb]

Sub 多个页面插入文本动画()
    Dim sp As Shape, sld As Slide, teff As Effect, i As Integer, st As String
   
    '每个幻灯片循环一次
    For Each sld In ActivePresentation.Slides
        
        '每个图形循环一次
        For Each sp In sld.Shapes
            If sp.Type = msoShapeCube Or sp.Type = msoTextBox Then '如果是占位框或文本框
                If InStr(1, sp.AlternativeText, "【正确答案】", vbTextCompare) > 0 Then '如果包含文本“【正确答案】”
                    
                    '整个文本框加入效果，实际会出现一系列动画
                    sld.TimeLine.MainSequence.AddEffect sp, msoAnimEffectFade, msoAnimateTextByFirstLevel, msoAnimTriggerOnPageClick
                    'msoAnimEffectFade 加入“渐入”效果
                    'msoAnimateTextByFirstLevel 按照第一级段落处理
                    'msoAnimTriggerOnPageClick 点击幻灯片触发效果
                    
                    '从后向前处理各动画，如果不包含特定文字则删除效果
                    For i = sld.TimeLine.MainSequence.Count To 1 Step -1
                        Set teff = sld.TimeLine.MainSequence(i)
                        st = teff.DisplayName   'DisplayName是效果的显示名称，这里实际就是段落文字
                        If InStr(1, st, "【正确答案】", vbTextCompare) > 0 Or InStr(1, st, "【答案解析】", vbTextCompare) > 0 Then
                            teff.Timing.Duration = 0.5    '把效果的持续时间设为0.5秒（非常快）,也可设为1秒（快速）
                        Else
                            teff.Delete '删除效果
                        End If
                    Next
                End If
            End If
        Next
    Next
End Sub

[/code]

多个页面插入文本动画（最后两行）.zip (43.18 KB, 下载次数: 192)

2013-8-2 12:56 上传

点击文件名下载附件

2337359709

csnAlex 发表于 2013-8-2 12:57
没找到方法把文本框中的特定段落加上效果，换了另外一种思路，先把整个文本框设置“渐入”效果，再把不符合 ...

非常感谢，帮大忙了

ww0000

csnAlex 发表于 2013-8-2 12:57
没找到方法把文本框中的特定段落加上效果，换了另外一种思路，先把整个文本框设置“渐入”效果，再把不符合 ...

太强大了,能不能批量为多个本文加上链接?

wangyihong99

csnAlex 发表于 2013-8-2 12:57
没找到方法把文本框中的特定段落加上效果，换了另外一种思路，先把整个文本框设置“渐入”效果，再把不符合 ...

不知道大家如何测试的？我试过，根本没效果，因为原本那“答案”就设计好动画效果，如果先把效果去掉，F8
运行无效，再加入Sub OnSlideShowPageChange()  中也无效！