目的：將設置有演示動畫的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
參見視頻：