TPE

[e-mail]

---

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

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

---