View Single Post
 
Old 09-27-2014, 09:50 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

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.
Reply With Quote