Random Power Point Slide Without Repetition

RandomSlide.vba

Dim NotShownSlideIndexes As New Collection
Dim HasStarted As Boolean

Sub OnSlideShowPageChange()
    If HasStarted = False Then
        HasStarted = True
        Set NotShownSlideIndexes = Nothing
        
        For Each Slide In ActivePresentation.Slides
            With Slide.Shapes(2).ActionSettings(ppMouseClick)
                .Action = ppActionRunMacro
                .Run = "ShowRandomSlide"
            End With
            NotShownSlideIndexes.Add Slide
        Next

        NotShownSlideIndexes.Remove 1
    End If
End Sub

Sub OnSlideShowTerminate(SW As SlideShowWindow)
    HasStarted = False
End Sub

Sub ShowRandomSlide()
    If NotShownSlideIndexes.Count > 0 Then
        Dim SelectedSlideIndex As Integer
        Randomize
        SelectedSlideIndex = Int(Rnd * NotShownSlideIndexes.Count) + 1
        ActivePresentation.SlideShowWindow.View.GotoSlide NotShownSlideIndexes(SelectedSlideIndex).SlideIndex
        NotShownSlideIndexes.Remove SelectedSlideIndex
    Else
        HasStarted = False
        ActivePresentation.SlideShowWindow.View.Exit
    End If
End Sub