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

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
 
G

Guest

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
 
G

Guest

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
 
M

Michael

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..
 
M

Michael

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top