标签:
杂谈 |
分类: PPT |
Office Professional Plus 2010/2013/2016包含的PowerPoint的“发布”功能可以做到,然而对于其他版本来说,此功能不可用。
难道我们就只能一页一页地手工保存吗?当然不用,因为可以通过VBA编程解决。下面是操作步骤:
-
用PowerPoint打开一个演示文稿,确保只有这一个PowerPoint窗口在运行。按Alt+F11快捷键,弹出“Microsoft
Visual Basic for Application”窗口,即VBA窗口。
http://s5/middle/001IczhTzy75wQVX87Gb4&690 - 点击“插入”→“模块”,此时在左侧“工程 -
VBAProject”窗口中出现一个“模块1”,在右侧灰色区域出现一个代码窗口。
http://s13/middle/001IczhTzy75wQVZdyA3c&690 -
将以下代码复制粘贴到代码窗口中,然后按F5快捷键运行代码,即可。
Sub SaveEachSlideAsASeparate
Presentation()
'获取当前演示文稿有多少张幻灯片
Dim lng_SldCnt As Long
lng_SldCnt = ActivePresentation.Slides.Count
'获取当前演示文稿的路径
Dim str_CurPath As String
str_CurPath = ActivePresentation.Path
'获取当前演示文稿的路径及完整文件名
Dim str_CurFN As String
str_CurFN = ActivePresentation.FullName
'在当前演示文稿所在位置创建保存文件夹
Dim str_StorDir As String
str_StorDir = str_CurFN & ".split"
If Dir(str_StorDir, vbDirectory) <> "" Then
'用FSO.deletefolder删除同名文件夹,其实也可以用Shell调用CMD调用RD命令删除,但是VBA的Shell没有Wait和TimeOut参数,所以。。。
CreateObject("Scripting.FileSystemObject").deletefolder str_StorDir
'用FSO.createfolder创建同名文件夹,如果用VBA.MkDir,可能会因为还没删除完旧的文件夹就创建新的同名文件夹而导致出错
CreateObject("Scripting.FileSystemObject").createfolder str_StorDir
Else
VBA.MkDir str_StorDir
End If
'用一个For...Next循环,在第i轮循环时,删除临时演示文稿中第i张幻灯片前后的所有幻灯片,并将临时演示文稿另存为(用SaveCopyAs方法,免得影响临时演示文稿)
Dim i As Long, j As Long, n As Long '循环的计数器
Dim str_StorName_Sepr As String 'Storage name of every separate slide
Dim arrSld() '用于保存幻灯片索引的数组,可以成组删除幻灯片
Dim sIndex As Long '数组的计数器
n = lng_SldCnt
Dim str_StorNameTemp As String 'storage name of the temporal presentation 本变量存储临时演示文稿的文件名
Dim str_SLID As String '这个变量存储的是“幻灯片i”,其中i为正整数
For i = 1 To n
'将当前演示文稿另存到保存文件夹,充当临时演示文稿,文件名形如“幻灯片i.PPTX”,注意用SaveCopyAs方法