将特定幻灯片导出为PPTX演示文稿

Question

我试图将大型演示文稿分解为更小的pptx文件。 我已经尝试了下面的代码，但我不认为导出函数适用于pptx。当我运行宏时，我得到Run-time error -2147467259 (80004005)': Slide (unknown member): Powerpoint can't export the slide(s) because no installed converter supports this file type.

Sub ExportCharts()
Dim savePath As String
Dim End_of_Pop As String


'Input box for End of POP for File Name
End_of_Pop = InputBox("Input End of POP (YYYYMMDD)")


'Create folder for files for sharepoint
MkDir ActivePresentation.Path & "\Week_Ending_" & End_of_Pop

'Export as PPTX
ActivePresentation.Slides.Range(Array(1, 2, 3, 4)).Export ActivePresentation.Path & "\Week_Ending_" & End_of_Pop & "\" & End_of_Pop & "_Weekly_AVA_Charts", "pptx"


End Sub

Answer 1

如何改变这种方法：对于每个需要的新pptx，复制原始pptx，然后根据需要删除幻灯片。这种方法手动和编程都很简单。如果我在这里遗漏了一些东西，请告诉我。

Answer 2

以下脚本将帮助您将演示文稿的各个幻灯片另存为单独的pptx文件。

只需在代码中更改以下内容即可

1. 使用要导出的演示文稿的文件路径更改K:\PRESENTATION_YOU_ARE_EXPORTING.pptx。
2. 将K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\更改为应保存导出的演示文稿的文件夹路径。
3. 请记住在步骤2中的文件夹路径末尾添加\。

   Sub ExportSlidesToIndividualPPPTX()
     Dim oPPT As Presentation, oSlide As Slide
     Dim sPath As String
     Dim oTempPres As Presentation
     Dim x As Long
   
     ' Location of PPTX File
     Set oPPT = Presentations.Open(FileName:="K:\PRESENTATION_YOU_ARE_EXPORTING.pptx")
     ' Location Where Individual Slides Should Be Saved
     ' Add \ in the end
     sPath = "K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\"
   
     For Each oSlide In oPPT.Slides
        lSlideNum = oSlide.SlideNumber
        sFileName = sPath & "Slide - " & lSlideNum & ".pptx"
        oPPT.SaveCopyAs sFileName
        ' open the saved copy windowlessly
        Set oTempPres = Presentations.Open(sFileName, , , False)
   
        ' Delete all slides before the slide you want to save
        For x = 1 To lSlideNum - 1
            oTempPres.Slides(1).Delete
        Next
   
        ' Delete all slides after the slide you want to save
        For x = oTempPres.Slides.Count To 2 Step -1
            oTempPres.Slides(x).Delete
        Next
   
        oTempPres.Save
        oTempPres.Close
   
     Next
   
     Set oPPT = Nothing
   
   End Sub