ppt中，将带有动画的ppt转换成多页pdf的vba代码

Option Explicit

Sub AddElements()
Dim shp As Shape

Dim i As Integer, n As Integer
n = ActivePresentation.Slides.Count
For i = 1 To n
    Dim s As Slide
    Set s = ActivePresentation.Slides(i)
    s.SlideShowTransition.Hidden = msoTrue
    
    Dim max As Integer: max = AnimationElements(s)
    Dim k As Integer, s2 As Slide
    For k = 1 To max
        Set s2 = s.Duplicate(1)
        s2.Name = "AutoGenerated: " & s2.SlideID
        s2.SlideShowTransition.Hidden = msoFalse
        s2.MoveTo ActivePresentation.Slides.Count
        
        Dim i2 As Integer, h As Shape
        Dim Del As New Collection
        For i2 = s2.Shapes.Count To 1 Step -1
            Set h = s2.Shapes(i2)
            If Not IsVisible(s2, h, k) Then Del.Add h
        Next
        Dim j As Integer
        For j = s.TimeLine.MainSequence.Count To 1 Step -1
            s2.TimeLine.MainSequence.Item(1).Delete
        Next
        For j = Del.Count To 1 Step -1
            Del(j).Delete
            Del.Remove j
        Next
    Next
Next
End Sub

'is the shape on this slide visible at point this time step (1..n)
Function IsVisible(s As Slide, h As Shape, i As Integer) As Boolean

'first search for a start state
Dim e As Effect
IsVisible = True
For Each e In s.TimeLine.MainSequence
    If e.Shape Is h Then
        IsVisible = Not (e.Exit = msoFalse)
        Exit For
    End If
Next

'now run forward animating it
Dim n As Integer: n = 1
For Each e In s.TimeLine.MainSequence
    If e.Timing.TriggerType = msoAnimTriggerOnPageClick Then n = n + 1
    If n > i Then Exit For
    If e.Shape Is h Then IsVisible = (e.Exit = msoFalse)
Next
End Function

'How many animation steps are there
'1 for a slide with no additional elements
Function AnimationElements(s As Slide) As Integer
AnimationElements = 1
Dim e As Effect
For Each e In s.TimeLine.MainSequence
    If e.Timing.TriggerType = msoAnimTriggerOnPageClick Then
        AnimationElements = AnimationElements + 1
    End If
Next
End Function

Sub RemElements()
Dim i As Integer, n As Integer
Dim s As Slide
n = ActivePresentation.Slides.Count
For i = n To 1 Step -1
    Set s = ActivePresentation.Slides(i)
    If s.SlideShowTransition.Hidden = msoTrue Then
        s.SlideShowTransition.Hidden = msoFalse
    ElseIf Left$(s.Name, 13) = "AutoGenerated" Then
        s.Delete
    End If
Next
End Sub

这段PPT宏代码主要由三个子程序（AddElements, IsVisible, AnimationElements）和一个删除生成的幻灯片的子程序（RemElements）组成。下面是它们各自的功能分析：

AddElements 子程序

这个子程序会遍历整个演示文稿的所有幻灯片，并为每一张幻灯片生成多个（根据动画元素的数量）复制的幻灯片，每个复制的幻灯片对应一个动画步骤。然后，它会根据动画步骤的可见性来决定是否删除幻灯片中的某些形状。

1. 遍历所有幻灯片：通过For i = 1 To n循环，程序会遍历演示文稿中的每一张幻灯片。
2. 复制幻灯片：对于每一张幻灯片，程序会根据其动画元素的数量（由AnimationElements函数计算）进行复制。每个复制的幻灯片对应原幻灯片中的一个动画步骤。
3. 设置幻灯片属性：复制的幻灯片会被重命名，并移动到演示文稿的最后。同时，其SlideShowTransition.Hidden属性会被设置为msoFalse，表示在幻灯片演示中这些幻灯片是可见的。
4. 删除不可见的形状：对于每一个复制的幻灯片，程序会检查其每一个形状在当前动画步骤中是否可见（由IsVisible函数判断）。如果不可见，该形状会被添加到Del集合中，并在后续步骤中被删除。
5. 删除所有动画：所有复制的幻灯片的动画都会被删除，只保留静态的形状。
6. 删除不可见的形状：最后，程序会遍历Del集合，并删除其中的所有形状。

IsVisible 函数

这个函数用于判断在给定的动画步骤中，一个形状是否可见。它首先搜索形状的初始状态，然后模拟动画的播放过程，判断形状在指定的动画步骤中是否可见。

AnimationElements 函数

这个函数计算一张幻灯片中有多少个动画步骤。它通过遍历幻灯片的时间线序列，并计算由页面点击触发的动画数量来实现。

RemElements 子程序

这个子程序用于清理由AddElements子程序生成的幻灯片。它会遍历所有的幻灯片，如果幻灯片的名称以"AutoGenerated"开头，那么这张幻灯片就会被删除。同时，它也会将所有隐藏的幻灯片的隐藏属性设置为可见。

总结

总的来说，这段宏代码的主要目的是将PPT中的动画效果“展开”成静态的幻灯片序列，每一个动画步骤都对应一张幻灯片。这样做的好处是可以让那些不支持动画的设备或软件能够正确地显示原本带有动画的PPT内容。同时，通过RemElements子程序，用户可以方便地清理生成的幻灯片，恢复原始的PPT结构。