Export Specific Slides as PPTX Presentations

Question

I'm trying to break a large presentation up into smaller pptx files.
I've tried the code below, but I don't think the export function works for pptx. When I run the macro I get 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

user_5576536 · Answer

The following script will help you save the individual slides of your presentation as seperate pptx files.

Just change the following in the code

Change K:\PRESENTATION_YOU_ARE_EXPORTING.pptx with the file path of the presentation you are exporting.
Change K:\FOLDER PATH WHERE PPTX SHOULD BE EXPORTED\ with the folder path where the exported presentations should be saved.

Remember to add \ at the end of the folder path in Step 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

Export Specific Slides as PPTX Presentations

2 Answers