VBA将PPT中选中的页单独另存为一个新的PPT文件（类似于2013版的发布功能）

daily444

2016版的PPT发布功能，多个页面都单独另存为了一个个新的PPT，不能将选中的多页保存在一个新PPT中。求大神写个简单的代码，实现此功能！ 感谢！！！

shenjianrong163

1. Sub SaveSelectionPage2PPT()
   
2.     Dim sld As Slide
   
3.     Dim i%, p%, d
   
4.     Dim pptFile$
   
5.     Set d = CreateObject("Scripting.Dictionary")
   
6.     On Error Resume Next
   
7.     pptFile = ActivePresentation.Path & "\导出幻灯片.ppt"
   
8.     ActivePresentation.SaveAs pptFile, ppSaveAsOpenXMLPresentation
   
9.     For Each sld In ActiveWindow.Selection.SlideRange
   
10.         d(sld.SlideIndex) = ""
    
11.     Next
    
12.     With ActivePresentation
    
13.         p = .Slides.Count
    
14.         For i = p To 1 Step -1
    
15.             If Not d.Exists(i) Then
    
16.                 .Slides(i).Delete
    
17.             End If
    
18.         Next
    
19.         .Save
    
20.     End With
    
21. End Sub

复制代码

daily444

shenjianrong163 发表于 2023-12-6 21:17

谢谢老哥！找到了另外一个解决方法：
Sub 导出选中页面()
    Dim prs As Presentation
    Dim prs1 As Presentation
    Dim fso As Object
    Dim 原文件名 As String
    Dim 后缀 As String
   
    Set prs = ActivePresentation
    Set prs1 = Presentations.Add
    Set fso = CreateObject("scripting.filesystemobject")
   
    原文件名 = fso.getbasename(prs.Name)
    后缀 = fso.getextensionname(prs.Name)
   
    Application.ActiveWindow.WindowState = ppWindowMinimized
   
    ActiveWindow.Selection.Copy
   
   
    prs1.Slides.Paste
   
   
   
    prs1.SaveAs prs.Path & "/" & 原文件名 & "-发布." & 后缀
    prs1.Close
   
    Set prs = Nothing
    Set prs1 = Nothing
   
    MsgBox "导出完成！"
End Sub

shenjianrong163

daily444 发表于 2023-12-7 15:57
谢谢老哥！找到了另外一个解决方法：
Sub 导出选中页面()
    Dim prs As Presentation

你这代码能运行吗？