HOW TO SPLIT UP SLIDES IN A PPT TO FORM A PPT FOR EACH SLIDE

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi , i want to split up ppt into its slides and this slide should now behave
as a individual ppt,...... please help

thanks in advance
 
You could of course open and delete all but one slide save as etc OR use
insert slides from files to make one slide presentations - both would be
pretty laborious.

OR you could use vba to do it. Try this (ON ACOPY) see if it does it for you
If you have 2007 change all the .ppt to .pptx:

Sub singles()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
'make a temp copy
ActivePresentation.SaveCopyAs (Environ("TEMP") _
& "\tempfile.ppt")
Set osource = Presentations.Open(Environ("TEMP") _
& "\tempfile.ppt")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Cut
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
otarget.SaveAs (Environ("USERPROFILE") & _
"\Desktop\Slide " & CStr(i)) & ".ppt"
otarget.Close
Set otarget = Nothing
Next
osource.Close
'remove temp copy
Kill (Environ("TEMP") & "\tempfile.ppt")
Set osource = Nothing
End Sub
 
Modified to follow master template!

Sub singles()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
ActivePresentation.SaveCopyAs (Environ("TEMP") & "\tempfile.ppt")
Set osource = Presentations.Open(Environ("TEMP") & "\tempfile.ppt")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Copy
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
otarget.Slides(1).Design = osource.Slides(i).Design
otarget.Slides(1).ColorScheme = osource.Slides(i).ColorScheme
osource.Slides(i).Delete
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\Slide " & CStr(i)) & ".ppt"
otarget.Close
Set otarget = Nothing
Next
osource.Close
Set osource = Nothing
End Sub
 
Is there a way to save the resulting file as the title of the slide?? I tried with

otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\" & ActivePresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text)

but didn't seem to work..
 
I got it working thanks..

Sub singles()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
'make a temp copy
ActivePresentation.SaveCopyAs (Environ("TEMP") _
& "\tempfile.ppt")
Set osource = Presentations.Open(Environ("TEMP") _
& "\tempfile.ppt")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Cut
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\test\" & ActivePresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text)
otarget.Close
Set otarget = Nothing
Next
osource.Close
'remove temp copy
Kill (Environ("TEMP") & "\tempfile.ppt")
Set osource = Nothing
End Sub



Submitted via EggHeadCafe
Stock Quotes via jQuery-enabled WCF Service, JSON, and jQuery Templates
http://www.eggheadcafe.com/tutorial...ed-wcf-service-json-and-jquery-templates.aspx
 
Back
Top