Delete all slides but those in a custom show

PPTools
Shape Styles brings the power of styles to PowerPoint. Apply complex formatting with a single click
Merge Excel, CSV or tab-delimited data into PowerPoint presentations to create certificates, awards presentations, personalized presentations and more
FixLinks prevents broken links when you distribute PowerPoint presentations
Optimizer saves disk space and bandwidth, shrinks your PowerPoint presentations to the right size for email, screenshow or printing
PPT2HTML gives you full control of PowerPoint HTML output, helps meet Section 508 accessibility requirements
Prep4PDF preserves interactivity in PowerPoint presentations when you convert to PDF
Image Export converts PowerPoint slides to JPG, PNG, GIF, WMF and more

Problem

You've got a big presentation with lots of slides. To keep it organized, you've created custom shows so you can deliver a presentation that includes only some of the material in your overall file.

Now somebody wants a copy of the presentation you gave them. You don't mind doing that, but you only want them to have the slides from the custom show they saw, not all of your material.

This little macro, edited to reflect the name of the show you want to preserve, will delete all of the slides in your presentation BUT the ones in your custom show.

Obviously, and pardon the yelling but it's important: RUN THIS ONLY ON A **COPY** OF YOUR MAIN PRESENTATION!!!

OK. We've got that out of the way. Here we go ...

Solution

Sub IsolateCustomShow()
' Deletes all slides but those in the named custom show

    Dim sShowName As String
    Dim x As Long
    Dim oSl As Slide

    ' edit this as needed or add an input box or other
    ' UI to get name of show from user
    sShowName = "DeleteMe"

    ' tag each slide in the show
    With ActivePresentation.SlideShowSettings.NamedSlideShows(sShowName)
        For x = 1 To .Count
            'Debug.Print TypeName(.SlideIDs(x))
            Set oSl = ActivePresentation.Slides.FindBySlideID(.SlideIDs(x))
            'Call ActivePresentation.Slides(.SlideIDs(x)).Tags.Add("KEEP", "YES")
            Call oSl.Tags.Add("KEEP", "YES")
        Next
    End With

    ' Delete any slides we haven't tagged as "keepers"
    For x = ActivePresentation.Slides.Count To 1 Step -1
        Set oSl = ActivePresentation.Slides(x)
        If oSl.Tags("KEEP") <> "YES" Then
            oSl.Delete
        Else
            ' blank the tag in case we run this again on a subset of this presentation
            oSl.Tags.Delete ("KEEP")
        End If
    Next

End Sub

Contents © 1995-2008 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.

content authoring & site maintenance by

Friday - The Automatic FAQ Maker