PPT现在是无处不在，好处自不必多说了。PPT除了上课时演示外，有时需要将PPT的内容放到其他的一些文档中，比如Word中使用，现在的问题就来了，如果将这些幻灯片快速提取，然后放到Word中使用。
想了很久，没找到合适的办法，最后试了下VBA，轻松搞定。
Public Sub Export_To_Image()
Dim SaveImagePath As String '定义文件保存路径变量
Dim SaveImageName As String '定义保存文件名变量
Dim SlideObject As Slide '定义Slide对象
On Error GoTo Err_SaveErr '如果保存错误转到Err_SaveErr标记处继续执行
SaveImagePath = "D:\SlidePic\" '定义保存文件的路径为“D:\SlidePic\”
For Each SlideObject In ActivePresentation.Slides
'递归每一张幻灯片对象
SaveImageName = SlideObject.Name & ".jpg"
'用幻灯片对象的名称作为保存文件的名字，“.jpg”，保存为“jpg”格式，可选bmp等其他格式
SlideObject.Export SaveImagePath & SaveImageName, "jpg"
'导出幻灯片对象到指定路径，以指定名命名
Next SlideObject '下一个幻灯片对象
Err_SaveErr: '错误处理标记
If Err <> 0 Then '如果发生错误执行以下代码
MsgBox Err.Description '弹出错误提示信息
End If
End Sub
Dim SaveImagePath As String '定义文件保存路径变量
Dim SaveImageName As String '定义保存文件名变量
Dim SlideObject As Slide '定义Slide对象
On Error GoTo Err_SaveErr '如果保存错误转到Err_SaveErr标记处继续执行
SaveImagePath = "D:\SlidePic\" '定义保存文件的路径为“D:\SlidePic\”
For Each SlideObject In ActivePresentation.Slides
'递归每一张幻灯片对象
SaveImageName = SlideObject.Name & ".jpg"
'用幻灯片对象的名称作为保存文件的名字，“.jpg”，保存为“jpg”格式，可选bmp等其他格式
SlideObject.Export SaveImagePath & SaveImageName, "jpg"
'导出幻灯片对象到指定路径，以指定名命名
Next SlideObject '下一个幻灯片对象
Err_SaveErr: '错误处理标记
If Err <> 0 Then '如果发生错误执行以下代码
MsgBox Err.Description '弹出错误提示信息
End If
End Sub
上述代码中“ActivePresentation.Slides”表示当前幻灯片中的幻灯片集合。
使用上面的代码最终保存的文件名会是类似于“Slide**.jpg”形式的文件名，根据制作幻灯片时情况的不同会不同，如果制作的过程中有删减的情况，则文件名会不连续，因此如果想让保存的文件名连续可以将上面的代码稍作变更即可。
Public Sub Export_To_Image()
Dim SaveImagePath As String '定义文件保存路径变量
Dim SaveImageName As String '定义保存文件名变量
Dim SlideObject As Slide '定义Slide对象
Dim i As Integer '定义命名序列个变量
On Error GoTo Err_SaveErr '如果保存错误转到Err_SaveErr标记处继续执行
i = 0 '变量i初始化
SaveImagePath = "D:\SlidePic\" '定义保存文件的路径为“D:\SlidePic\”
For Each SlideObject In ActivePresentation.Slides
'递归每一张幻灯片对象
i = i + 1 '命名序列号递增
SaveImageName = i & ".jpg" '以i的数值为文件名，从而保证文件名按顺序递增
SlideObject.Export SaveImagePath & SaveImageName, "jpg"
'导出幻灯片对象到指定路径，以指定名命名
Next SlideObject
Err_SaveErr: '错误处理标记
If Err <> 0 Then '如果发生错误执行以下代码
MsgBox Err.Description '弹出错误提示信息
End If
End Sub
Dim SaveImagePath As String '定义文件保存路径变量
Dim SaveImageName As String '定义保存文件名变量
Dim SlideObject As Slide '定义Slide对象
Dim i As Integer '定义命名序列个变量
On Error GoTo Err_SaveErr '如果保存错误转到Err_SaveErr标记处继续执行
i = 0 '变量i初始化
SaveImagePath = "D:\SlidePic\" '定义保存文件的路径为“D:\SlidePic\”
For Each SlideObject In ActivePresentation.Slides
'递归每一张幻灯片对象
i = i + 1 '命名序列号递增
SaveImageName = i & ".jpg" '以i的数值为文件名，从而保证文件名按顺序递增
SlideObject.Export SaveImagePath & SaveImageName, "jpg"
'导出幻灯片对象到指定路径，以指定名命名
Next SlideObject
Err_SaveErr: '错误处理标记
If Err <> 0 Then '如果发生错误执行以下代码
MsgBox Err.Description '弹出错误提示信息
End If
End Sub
以上代码全部在Windows XP SP3+PowerPoint 2010 Beta环境下测试通过，第二部分代码执行最后的结果如下图所示。
在Windows XP SP3下按“文件名”排序，会自动从小到大排序，印象中以前的版本会按1、10这样的顺序，如果出现这种情况而又想保证按顺序显示，可将上面的代码再稍作变更，也就是在“i”小于等于9的情况下，在前面再加个字符串“0”，这样最终保存的结果就会是01、02……、10、11这样的形式了。
本文转自windyli 51CTO博客，原文链接：http://blog.51cto.com/windyli/304720，如需转载请自行联系原作者
