将一个PowerPoint幻灯片文档按页分割成多个PowerPoint幻灯片文档的代码
1.将一个PPT文档按页分割成多个PPT文档的代码
请尝试如下步骤：1、打开需要分割的PPT文档（假设文件名为“原始文档.ppt”）;2、键入Alt+F11切换到VBA编辑环境，然后选择菜单“插入-模块”；3、在代码编辑区粘贴如下代码：Option ExplicitSub SplitSlides() Dim oSrcPresentation As Presentation, oNewPresentation As Presentation Dim strSrcFileName As String, strNewFileName As String Dim nIndex As Integer, nSubIndex As Integer, nTotalSlides As Integer, nBound As Integer, nCounter As Integer Dim fso As Object Const nSteps = 5 ' 修改这里控制每隔几页分割一次 If nSteps <= 0 Then Exit Sub Set fso = CreateObject("Scripting.FileSystemObject") Set oSrcPresentation = ActivePresentation strSrcFileName = oSrcPresentation.FullName nTotalSlides = oSrcPresentation.Slides.Count nCounter = 1 For nIndex = 1 To nTotalSlides Step nSteps If nIndex + nSteps > nTotalSlides Then nBound = nTotalSlides Else nBound = nIndex + nSteps - 1 End If strNewFileName = fso.BuildPath(fso.GetParentFolderName(strSrcFileName), _ fso.GetBaseName(strSrcFileName) & "_" & nCounter & "." & fso.GetExtensionName(strSrcFileName)) oSrcPresentation.SaveCopyAs strNewFileName Set oNewPresentation = Presentations.Open(strNewFileName) If nBound < nTotalSlides Then For nSubIndex = nBound + 1 To nTotalSlides oNewPresentation.Slides(nBound + 1).Delete Next End If If nIndex > 1 Then For nSubIndex = 1 To nIndex - 1 oNewPresentation.Slides(1).Delete Next End If oNewPresentation.Save oNewPresentation.Close nCounter = nCounter + 1 Next nIndex MsgBox "结束！"， vbInformationEnd Sub4、修改代码中指定的分割页数；5、键入F5运行，直到提示“完成！”6、在源PPT所在目录下生成一系列命名为“原始文档_1.ppt”、“原始文档_2.ppt”……的新文档，即为分割之后的结果。
附注：原来想用更简单的一个API函数Slides.InsertFromFile，但是发现通过这个函数插入的PPT无法保留原始文档中的背景等信息。所以只好采用现在这样的另存为并删除多余幻灯片的“笨”办法了。
其它朋友看看有没有更好的主意，也可以分享一下……。
2.将一个PPT文档按页分割成多个PPT文档的代码
请尝试如下步骤：1、打开需要分割的PPT文档（假设文件名为“原始文档.ppt”）;2、键入Alt+F11切换到VBA编辑环境，然后选择菜单“插入-模块”；3、在代码编辑区粘贴如下代码：Option Explicit Sub SplitSlides() Dim oSrcPresentation As Presentation, oNewPresentation As Presentation Dim strSrcFileName As String, strNewFileName As String Dim nIndex As Integer, nSubIndex As Integer, nTotalSlides As Integer, nBound As Integer, nCounter As Integer Dim fso As Object Const nSteps = 5 ' 修改这里控制每隔几页分割一次 If nSteps <= 0 Then Exit Sub Set fso = CreateObject("Scripting.FileSystemObject") Set oSrcPresentation = ActivePresentation strSrcFileName = oSrcPresentation.FullName nTotalSlides = oSrcPresentation.Slides.Count nCounter = 1 For nIndex = 1 To nTotalSlides Step nSteps If nIndex + nSteps > nTotalSlides Then nBound = nTotalSlides Else nBound = nIndex + nSteps - 1 End If strNewFileName = fso.BuildPath(fso.GetParentFolderName(strSrcFileName), _ fso.GetBaseName(strSrcFileName) & "_" & nCounter & "." & fso.GetExtensionName(strSrcFileName)) oSrcPresentation.SaveCopyAs strNewFileName Set oNewPresentation = Presentations.Open(strNewFileName) If nBound < nTotalSlides Then For nSubIndex = nBound + 1 To nTotalSlides oNewPresentation.Slides(nBound + 1).Delete Next End If If nIndex > 1 Then For nSubIndex = 1 To nIndex - 1 oNewPresentation.Slides(1).Delete Next End If oNewPresentation.Save oNewPresentation.Close nCounter = nCounter + 1 Next nIndex MsgBox "结束！"， vbInformation End Sub4、修改代码中指定的分割页数；5、键入F5运行，直到提示“完成！”6、在源PPT所在目录下生成一系列命名为“原始文档_1.ppt”、“原始文档_2.ppt”……的新文档，即为分割之后的结果。
附注：原来想用更简单的一个API函数Slides.InsertFromFile，但是发现通过这个函数插入的PPT无法保留原始文档中的背景等信息。所以只好采用现在这样的另存为并删除多余幻灯片的“笨”办法了。
其它朋友看看有没有更好的主意，也可以分享一下……。