Haha I solved my own thread. I just gave it some thinking and came up with a pretty cool way to pull it off.
Basically I threw all of the custom show slide IDs into a comma separated string. Then I ran a random loop to throw each of those sets into a bigger string. Converted that string into an array and then made that array into it's own custom show. Here is the code.
Code:
Option Explicit
Sub RandomCustomShow()
Dim Show() As String, TotalShows As Integer, x As Integer
Dim pst As Presentation, SlideString() As String, Id As Integer
Dim RandSet As Integer, TotalSetString As String, TotalSets As Integer
Dim ShowString As String, TempArray As Variant, FinalShow() As Long
Dim Confirm As String
Set pst = ActivePresentation
TotalShows = pst.SlideShowSettings.NamedSlideShows.Count
If TotalShows = 0 Then
MsgBox ("No Custom Shows")
End
End If
'See if the TempShow is already in there.
For x = 1 To TotalShows
If pst.SlideShowSettings.NamedSlideShows(x).Name = "!!!TempShow" Then
Confirm = MsgBox("The Tempshow already exists would you like to replace it?", vbYesNo)
If Confirm = vbYes Then
pst.SlideShowSettings.NamedSlideShows(x).Delete
TotalShows = TotalShows - 1
Exit For
Else
End
End If
End If
Next x
ReDim Show(1 To TotalShows) As String
ReDim SlideString(1 To TotalShows) As String
TotalSetString = InputBox("How long do you want the custom show?" & vbLf _
& "Enter a number between 1 and 100")
If TotalSetString = "" Then End
If Not IsNumeric(TotalSetString) Then
MsgBox "You must enter a number. Program ending"
End
End If
TotalSets = CInt(TotalSetString)
'Store the shows in an array
For x = 1 To TotalShows
Show(x) = pst.SlideShowSettings.NamedSlideShows(x).Name
With pst.SlideShowSettings.NamedSlideShows(x)
For Id = 1 To .Count
SlideString(x) = SlideString(x) & .SlideIDs(Id) & ","
Next Id
End With
Next x
For x = 1 To TotalSets
RandSet = Int(Rnd() * TotalShows) + 1 'Use + 1 because arrays start at 0
ShowString = ShowString & SlideString(RandSet)
Next x
ShowString = Left(ShowString, Len(ShowString) - 1) 'Remove last comma
TempArray = Split(ShowString, ",")
ReDim FinalShow(0 To UBound(TempArray)) As Long
'Convert the array to a useable one.
For x = 0 To UBound(TempArray)
FinalShow(x) = CLng(TempArray(x))
Next x
'Add the show to the Custom Shows List
pst.SlideShowSettings.NamedSlideShows.Add "!!!TempShow", FinalShow
Confirm = MsgBox("!!!TempShow has been created in the custom shows and can be ran now." & _
vbLf & "Would you like to run it now?", vbYesNo)
If Confirm = vbNo Then End
With pst.SlideShowSettings
' change these as needed
.ShowType = ppShowTypeSpeaker
.LoopUntilStopped = msoTrue
.ShowWithNarration = msoTrue
.ShowWithAnimation = msoTrue
.RangeType = ppShowNamedSlideShow
.SlideShowName = "!!!TempShow"
.Run
End With
End Sub
Thanks to anybody that took a look at this I know it was probably a brain teaser.