目的：将设置有演示动画的PPT转换为有动画的PDF文件
方法一：1. 打开PPT 2.视图 3.宏 4.创建新的宏文件
5.复制代码（将原本的两行代码删除，复制新的进去） 6.重回PPT主页中点击 宏 7.点击addElements后点击运行 ，即可看到PPT页面中多出许多自动生成的页数 8.这时将PPT保存文件为PDF形式--done, 对于原来的PPT文件可关闭保存不做修改，也可点击remElements后点击运行然后多出的页数就会自动消失，这时再保存
要复制进去的代码：
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
方法二：操作步骤同上，代码只不过进行了改进，因为上述方法做出的PDF比实际页数要多，多出的是自动生成的页数，（对于如果要添加页脚标注的话，则会出现与实际不符的情况，对于无页脚页数标注的情况则没影响），对于有页脚标注页数要求的则可以采用的二种方法；
对应的代码：
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
Dim oshp As Shape
With s2.Shapes
Set oshp = .AddTextbox(msoTextOrientationHorizontal, 10, 10, 100, 50)
oshp.TextFrame.TextRange.Font.Name = "Arial"
oshp.TextFrame.TextRange.Font.Size = 12
oshp.TextFrame.TextRange.InsertAfter "" & i
End With
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
这里出现的也页码会自动出现在左上方，可以更改代码中的这一行的数字从而改变其页码的位置
Set oshp = .AddTextbox(msoTextOrientationHorizontal, 10, 10, 100, 50)
改成如下：
Set oshp = .AddTextbox(msoTextOrientationHorizontal, 698, 510, 100, 50)
这时候页码位置就会在右下角位置了！注意在改了之后，需要将原来自动产生的文件点击 RemElments ,运行之后重新点击AddElements,再运行；
代码一链接：http://neilmitchell.blogspot.com/2007
代码二 链接：https://gist.github.com/pcmoritz/4b0e
备份：https://github.com/MMehrez/Convert_PP
参见视频：