Create a custom show from current slide selection using VBA

Problem

You need to create a custom show programmatically using VBA, for example, from a selection of slides the user's made in the slide sorter.

Solution

This code creates a custom show from the current selected slides.

To use it, put PowerPoint in Slide Sorter view. Click the first slide you want to add to your custom show, Ctrl+Click the other slides you want to include, then run the code below to create a custom show from the selected slides.

Why the emphasis on Ctrl+Clicking? Because PowerPoint is sometimes weird and inconsistent.

If you select a range of slides by clicking the first slide then Shift+Clicking the last slide, the order of the slides in the resulting custom show will be unpredictable, probably reversed, with some slides completely out of order.

Option Explicit

Sub CreateCustomShowFromSelection()

    Dim x As Long
    Dim MySlideIDs() As Long
    Dim sShowName As String

    ' Did the user select some slides?  If not, quit:
    If ActiveWindow.Selection.Type <> ppSelectionSlides Then
        MsgBox "Please select one or more slides in the" _
                      & " SLIDE SORTER, then try again"
        Exit Sub
    End If

    With ActiveWindow.Selection.SlideRange
        ' add the SlideID of each slide in current
        ' selection to an array

        ' start with one member in the array
        ReDim MySlideIDs(1 To 1) As Long

        ' step BACKWARDS through selection, else
        ' the show will be in reverse order:
        For x = .Count To 1 Step -1
            MySlideIDs(UBound(MySlideIDs)) = .Item(x).SlideID
            Debug.Print .Item(x).Name
            ReDim Preserve MySlideIDs(1 To UBound(MySlideIDs) + 1)
        Next

    End With

    ' Get a name for the show
    sShowName = InputBox("Name for your custom show:", _
                            "Custom show name", "")

    ' Quit if blank
    If Len(sShowName) = 0 Then
        Exit Sub
    End If

    ' now create a custom show using the array
    With ActivePresentation.SlideShowSettings.NamedSlideShows
        ' delete the custom show if it already exists:
        On Error Resume Next
        .Item(sShowName).Delete
        On Error GoTo 0

        Call .Add(sShowName, MySlideIDs)

    End With

End Sub

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

Background

---