VBA code to save a single slide as a .ppt - vba

Question

I have a code which saves my specified slide as a PNG:
Dim userName As String
userName = Slide322.TextBox1.Text
'Save slide
ActivePresentation.Slides(302).Export _
filename:="C:\Users\Jessica\Dropbox\Uni\DISSERTATION\Questionnaire\Tools\Results\" & userName & ".png", FilterName:="PNG"
However, I want to save the slide as a .PPT so that I can open it at a later date and edit the text on that slide.
I have tried using the .SaveAs syntax, but I get an error message every time and it just won't recognise any 'Save' type expressions.
I have searched, and searched for the answer to this... Can anyone please help?

Answer 1

Try:
ActivePresentation.Slides(1).Export "c:\temp\slide1.ppt", "PPT"
Alternative:
Use SaveCopy to save a copy of the presentation
Open the saved copy (with or without a window)
Delete all the slides up to the one you want to keep
Delete all the slides after the one you want to keep
Save again.
Close the presentation
Like so:
Sub TestMe()
SaveSlide 5, "c:\temp\slide5.pptx"
End Sub
Sub SaveSlide(lSlideNum As Long, sFileName As String)
Dim oTempPres As Presentation
Dim x As Long
ActivePresentation.SaveCopyAs sFileName
' open the saved copy windowlessly
Set oTempPres = Presentations.Open(sFileName, , , False)
For x = 1 To lSlideNum - 1
oTempPres.Slides(1).Delete
Next
' What was slide number lSlideNum is now slide 1
For x = oTempPres.Slides.Count To 2 Step -1
oTempPres.Slides(x).Delete
Next
oTempPres.Save
oTempPres.Close
End Sub
Obviously, you'll want to add a few safety ropes ... don't try to export slide 15 of a 12-slide presentation, etc.

Answer 2

You could possibly try this code which:
creating new presentation
copying slide to it
saving & closing new presentation.
Sub SaveSeparateSlide()
Dim curPres As Presentation
Set curPres = ActivePresentation
Dim newPres As Presentation
Set newPres = Presentations.Add
'change slide number here:
curPres.Slides(1).Copy
newPres.Slides.Paste
'change your path and name here:
newPres.SaveAs "single slide presentation.pptx"
newPres.Close
End Sub
You will need to adjust that code a bit but I think you'll cope :)

Answer 3

Sub SplitFile()
Dim lSlidesPerFile As Long
Dim lTotalSlides As Long
Dim oSourcePres As Presentation
Dim otargetPres As Presentation
Dim sFolder As String
Dim sExt As String
Dim sBaseName As String
Dim lCounter As Long
Dim lPresentationsCount As Long ' how many will we split it into
Dim x As Long
Dim lWindowStart As Long
Dim lWindowEnd As Long
Dim sSplitPresName As String
On Error GoTo ErrorHandler
Set oSourcePres = ActivePresentation
If Not oSourcePres.Saved Then
MsgBox "Please save your presentation then try again"
Exit Sub
End If
lSlidesPerFile = CLng(InputBox("How many slides per file?", "Split Presentation"))
lTotalSlides = oSourcePres.Slides.Count
sFolder = ActivePresentation.Path & "\"
sExt = Mid$(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") + 1)
sBaseName = Mid$(ActivePresentation.Name, 1, InStr(ActivePresentation.Name, ".") - 1)
If (lTotalSlides / lSlidesPerFile) - (lTotalSlides \ lSlidesPerFile) > 0 Then
lPresentationsCount = lTotalSlides \ lSlidesPerFile + 1
Else
lPresentationsCount = lTotalSlides \ lSlidesPerFile
End If
If Not lTotalSlides > lSlidesPerFile Then
MsgBox "There are fewer than " & CStr(lSlidesPerFile) & " slides in this presentation."
Exit Sub
End If
For lCounter = 1 To lPresentationsCount
' which slides will we leave in the presentation?
lWindowEnd = lSlidesPerFile * lCounter
If lWindowEnd > oSourcePres.Slides.Count Then
' odd number of leftover slides in last presentation
lWindowEnd = oSourcePres.Slides.Count
lWindowStart = ((oSourcePres.Slides.Count \ lSlidesPerFile) * lSlidesPerFile) + 1
Else
lWindowStart = lWindowEnd - lSlidesPerFile + 1
End If
' Make a copy of the presentation and open it
sSplitPresName = sFolder & sBaseName & _
"_" & CStr(lWindowStart) & "-" & CStr(lWindowEnd) & "." & sExt
oSourcePres.SaveCopyAs sSplitPresName, ppSaveAsDefault
Set otargetPres = Presentations.Open(sSplitPresName, , , True)
With otargetPres
For x = .Slides.Count To lWindowEnd + 1 Step -1
.Slides(x).Delete
Next
For x = lWindowStart - 1 To 1 Step -1
.Slides(x).Delete
Next
.Save
.Close
End With
Next ' lpresentationscount
NormalExit:
Exit Sub
ErrorHandler:
MsgBox "Error encountered"
Resume NormalExit
End Sub

Answer 4

ActivePresentation.Slides(1).Export "1.ppt", "PPT"
Above code exports Slide#1 to an 'old' type ppt format.
The 2nd one of the following 2 macros can save a copy in a 'new' pptx format which is more compatible. It's actually the mixture of Steve's two methods. But it doesn't bother to delete the rest of the slides.
Sub SaveEachPage2PPT()
Dim sld As Slide
Dim l#
With ActivePresentation
For Each sld In .Slides
l = l + 1
sld.Export .Path & "\" & l & ".ppt", "PPT"
Next sld
End With
End Sub
Sub SaveEachPage2PPTX()
Dim sld As Slide
Dim l#
Dim ppt As Presentation
Dim pptFile$
With ActivePresentation
For Each sld In .Slides
l = l + 1
pptFile = .Path & "\" & l & ".ppt"
sld.Export pptFile, "PPT"
Set ppt = Presentations.Open(pptFile, , , False)
ppt.SaveCopyAs pptFile & "x", ppSaveAsOpenXMLPresentation
ppt.Close
Kill pptFile
Next sld
End With
If Not ppt Is Nothing Then Set ppt = Nothing
End Sub

Answer 5

The following script will help you save the individual slides of your presentation as seperate pptx files. I modified #Steve Rindsberg code to achieve this.
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