Consulting

Results 1 to 5 of 5

Thread: How can I separate each slides from one PPT file?

  1. #1
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    3
    Location

    How can I separate each slides from one PPT file?

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,648
    Location
    When you crosspost on other forums its ALWAYS good to mention this.
    https://answers.microsoft.com/en-us/...c-c0a40721339f

    See if this works:

    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    3
    Location
    Quote Originally Posted by John Wilson View Post
    When you crosspost on other forums its ALWAYS good to mention this.
    https://answers.microsoft.com/en-us/...c-c0a40721339f

    See if this works:

    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

    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?

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    1,648
    Location
    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.

    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
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    3
    Location
    Quote Originally Posted by John Wilson View Post
    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.

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •