怎樣把PPT拆散成單頁？

有時我們需要把一個PPT拆散成單頁，即，把每一張幻燈片另存為一個單獨的演示文稿。

在PowerPoint 2013/2016裡面點擊文件→共享→發布幻燈片就可以做到，但是這個功能只對Office專業版或企業版開放，其他版本沒法用。（你從網上買的幾百塊一套的Office軟體包，或者幾百塊一年的Office 365服務，既不是專業版，又不是企業版）。

難道我們就只能一頁一頁地手工保存嗎？當然不用，因為可以通過VBA編程解決。這個方法適用於PowerPoint 2007~2016的任何版本。下面是操作步驟：

1. 用PowerPoint打開一個演示文稿，確保只有這一個PowerPoint窗口在運行。按Alt+F11快捷鍵，彈出「Microsoft Visual Basic for Application」窗口，即VBA窗口。

2. 點擊「插入」→「模塊」，此時在左側「工程 - VBAProject」窗口中出現一個「模塊1」，在右側灰色區域出現一個代碼窗口。

Sub SaveEachSlideAsASeparatePresentation()nn 獲取當前演示文稿有多少張幻燈片n Dim lng_SldCnt As Longn lng_SldCnt = ActivePresentation.Slides.Countnn 獲取當前演示文稿的路徑n Dim str_CurPath As Stringn str_CurPath = ActivePresentation.Pathnn 獲取當前演示文稿的路徑及完整文件名n Dim str_CurFN As Stringn str_CurFN = ActivePresentation.FullNamenn 在當前演示文稿所在位置創建保存文件夾n Dim str_StorDir As Stringn str_StorDir = str_CurFN & ".split"n If Dir(str_StorDir, vbDirectory) <> "" Thenn 用FSO.deletefolder刪除同名文件夾，其實也可以用Shell調用CMD調用RD命令刪除，但是VBA的Shell沒有Wait和TimeOut參數，所以。。。n CreateObject("Scripting.FileSystemObject").deletefolder str_StorDirn 用FSO.createfolder創建同名文件夾，如果用VBA.MkDir，可能會因為還沒刪除完舊的文件夾就創建新的同名文件夾而導致出錯n CreateObject("Scripting.FileSystemObject").createfolder str_StorDirn Elsen VBA.MkDir str_StorDirn End Ifnnn 用一個For...Next循環，在第i輪循環時，刪除臨時演示文稿中第i張幻燈片前後的所有幻燈片，並將臨時演示文稿另存為（用SaveCopyAs方法，免得影響臨時演示文稿）n Dim i As Long, j As Long, n As Long 循環的計數器n Dim str_StorName_Sepr As String Storage name of every separate sliden Dim arrSld() 用於保存幻燈片索引的數組，可以成組刪除幻燈片n Dim sIndex As Long 數組的計數器n n = lng_SldCntn Dim str_StorNameTemp As String storage name of the temporal presentation 本變數存儲臨時演示文稿的文件名n Dim str_SLID As String 這個變數存儲的是「幻燈片i」，其中i為正整數n For i = 1 To nnn 將當前演示文稿另存到保存文件夾，充當臨時演示文稿，文件名形如「幻燈片i.PPTX」，注意用SaveCopyAs方法n str_SLID = "幻燈片" & in str_StorNameTemp = str_StorDir & "" & str_SLIDn ActivePresentation.SaveCopyAs str_StorNameTemp, ppSaveAsDefaultnn 用兩組IF判斷語句，確定臨時演示文稿的擴展名，並將其完整路徑和完整文件名寫入變數str_StorNameTempn If Right(Dir(str_StorNameTemp & ".*", vbNormal), 3) = "ppt" Then str_StorNameTemp = str_StorNameTemp & ".ppt"n If Right(Dir(str_StorNameTemp & ".*", vbNormal), 3) = "ptx" Then str_StorNameTemp = str_StorNameTemp & ".pptx"n Presentations.Open str_StorNameTemp, msoFalse, msoFalse, msoTrue 打開臨時演示文稿，令窗口可見，因為我沒有設計窗體也沒有設計滾動條nn 定義變數CurSlds為幻燈片集合（Slides）對象變數n Dim CurSlds As Slidesn Set CurSlds = Presentations(str_SLID).Slidesnn 分類討論：在i=1，i=n，1<i<n這三種情況下，如何處理n Select Case in i=1時，把第2到第n張幻燈片的編號依次寫入動態數組arrSld，後者是數列，通項公式是arrSld(m)=m+1，m<=n-1n Case 1n For j = 2 To nn sIndex = sIndex + 1n ReDim Preserve arrSld(1 To sIndex)n arrSld(sIndex) = jn Next jn i=n時，把第2到第n張幻燈片的編號依次寫入動態數組arrSld，後者是數列，通項公式是arrSld(m)=m，m<=n-1n Case nn For j = 1 To n - 1n sIndex = sIndex + 1n ReDim Preserve arrSld(1 To sIndex)n arrSld(sIndex) = jn Next jn 1<i<n時，把第i張幻燈片兩側所有幻燈片的編號分別依次寫入動態數組arrSld，後者是數列，通項公式是arrsld(m)=m，m<=i-1；arrSld(m)=m+1，m>=in Case Elsen For j = 1 To i - 1n sIndex = sIndex + 1n ReDim Preserve arrSld(1 To sIndex)n arrSld(sIndex) = jn Next jn For j = i + 1 To nn sIndex = sIndex + 1n ReDim Preserve arrSld(1 To sIndex)n arrSld(sIndex) = jn Next jn End Selectn CurSlds.Range(arrSld).Delete 把編號寫入動態數組arrSld的所有幻燈片都刪掉nnn 重置數組及其計數器n sIndex = 0n Erase arrSld()nnn 把臨時演示文稿（此時僅剩原演示文稿的第i張幻燈片）保存成文件名形如「幻燈片i.pptx」的演示文稿，然後關閉n Presentations(str_SLID).Saven Presentations(str_SLID).Closen Next inn 調用資源管理器打開保存文件夾n Dim str_SCL As String SCL = shell command linen str_SCL = "Explorer.exe" & " " & str_StorDirn Shell str_SCL, vbNormalFocusnn End Subn

4. 要退出，只需直接關閉PowerPoint窗口即可，無需保存代碼。

【補】演算法解讀

用一個For…Next循環，在第i輪循環時，將當前演示文稿複製一份（注意用SaveCopyAs方法），作為臨時演示文稿，刪除臨時演示文稿中第i張幻燈片前後的所有幻燈片，並將臨時演示文稿保存。