Supercharge your PowerPoint productivity with
Supercharge your PPT Productivity with PPTools - Click here to learn more.

PPTools

Image Export converts PowerPoint slides to high-quality images.

PPT2HTML exports HTML even from PowerPoint 2010 and 2013, gives you full control of PowerPoint HTML output, helps meet Section 508 accessibility requirements

Merge Excel data into PowerPoint presentations to create certificates, awards presentations, personalized presentations and more

Resize your presentations quickly and without distortion

Language Selector switches the text in your presentation from one language to another

FixLinks prevents broken links when you distribute PowerPoint presentations

Shape Styles brings styles to PowerPoint. Apply complex formatting with a single click.

Prep4PDF preserves interactivity in PowerPoint presentations when you convert to PDF

Break a presentation up into several smaller presentations

Problem

You have a large presentation that's

You want to split it into several smaller presentations. You can do it manually, of course; make several copies of your original presentation, open each in turn and delete all but the slides you want to leave in it, then save.

Or you can let VBA do the job for you automatically. Read on ...

Solution

This VBA routine will ask how many slides you want per presentation, then will split your presentation into several sub-presentations, each with the number of slides you requested, each named to reflect the slide numbers it contains.

For example, if your original file MySlides.PPT contains 55 slides and you ask SplitFile to split it to 25 slides per file, you'll get:

The new files will be saved to the same folder as the original file. The original file will not be altered.

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

See How do I use VBA code in PowerPoint? to learn how to use this example code.


Did this solve your problem? If so, please consider supporting the PPT FAQ with a small PayPal donation.
Page copy protected against web site content infringement by Copyscape Contents © 1995 - 2015 Stephen Rindsberg, Rindsberg Photography, Inc. and members of the MS PowerPoint MVP team. You may link to this page but any form of unauthorized reproduction of this page's contents is expressly forbidden.
Español    Deutsch    Français    Português    Italiano    Nederlands    Greek    Japanese    Korean    Chinese

Supercharge your PPT Productivity with PPTools

content authoring & site maintenance by
Friday, the automatic faq maker (logo)
Friday - The Automatic FAQ Maker

Break a presentation up into several smaller presentations
http://www.pptfaq.com/FAQ01086_Break_a_presentation_up_into_several_smaller_presentations.htm
Last update 07 June, 2011
Created: