Printable View
Hi Everyone.
I have a powerpoint file(Power point 2016) which has 100 page(slides). What I want is to automatically separate each slide to create 100 seperate powerpoint files with keeping the existing masterslide features, design and layout. I actually achieved this operation with a macro. However it is changing all layout and master slide features. Is there any way to do that easily in a way I desire to do ?
Thank you very much in advance
When you crosspost on other forums its ALWAYS good to mention this.
https://answers.microsoft.com/en-us/...c-c0a40721339f
See if this works:
Code:Sub splitFiles()
Dim tempR As Presentation
Dim opres As Presentation
Dim L As Long
Dim oFolder As String
'requires v. 2010 or later
On Error Resume Next
Set opres = ActivePresentation
Set tempR = Presentations.Add
oFolder = Environ("USERPROFILE") & "\Desktop\Files\"
MkDir oFolder
For L = 1 To opres.Slides.Count
opres.Slides(L).Copy
tempR.Windows(1).Panes(1).Activate
Call CommandBars.ExecuteMso("PasteSourceFormatting")
Call tempR.SaveCopyAs(oFolder & "Slide" & CStr(L) & ".pptx", ppSaveAsOpenXMLPresentation)
tempR.Slides(1).Delete
Next L
tempR.Saved = True
tempR.Close
End Sub
Quote:
Originally Posted by John Wilson
Hello John Wilson, Thanks a lot for your answer.
Your code generates better results but still not in a way I want. Because The original slide size is 4:3 but when I seperate that with your code, it is becoming 9:16 and affecting all other text and titles changing their location. I want the slides stay in same size when we seperated them with macro. How can we do that?
Good to mention your original was 4:3. Also if this works can I ask that you go back to the other forums where you asked because otherwise folk may be working away on it whan you already have an answer.
Code:Sub splitFiles()
Dim tempR As Presentation
Dim opres As Presentation
Dim L As Long
Dim oFolder As String
'requires v. 2010 or later
On Error Resume Next
Set opres = ActivePresentation
Set tempR = Presentations.Add
tempR.PageSetup.SlideSize = opres.PageSetup.SlideSize
oFolder = Environ("USERPROFILE") & "\Desktop\Files\"
MkDir oFolder
For L = 1 To opres.Slides.Count
opres.Slides(L).Copy
tempR.Windows(1).Panes(1).Activate
Call CommandBars.ExecuteMso("PasteSourceFormatting")
Call tempR.SaveCopyAs(oFolder & "Slide" & CStr(L) & ".pptx", ppSaveAsOpenXMLPresentation)
tempR.Slides(1).Delete
Next L
tempR.Saved = True
tempR.Close
End Sub
John Wilson. Thanks a lot. Now it is working completely right. I will copy the answer for my other questions in other forums and will informed them it is the answer.Quote:
Originally Posted by John Wilson