#1
|
|||
|
|||
Several Custom Shows in Random Order
Hi Everyone,
I have several presentations that I want to create custom shows for. I then would like to be able to run a script or add in that will play those custom shows but in a random order. Example CustomShow 1 has slides 1 to 4 CustomShow2 has slides 5 to 9 CustomShow3 has slides 10 to 15 When running the script a possibility would be CustomShow2 is played, then CustomShow1 and then CustomShow3 I know its easy to make the whole presentation random but I want the custom shows to be played with each show set being random. Again like the example CustomShow2 is played, then CustomShow1 and then CustomShow3. Once that works I want these shows to keep playing in different random orders but again the customshow sequence needs to be held. They would be stopped by hitting ESC on the keyboard to end the show. so the final example might be: CustomShow2 played, CustomShow1 played, CustomShow1 played, CustomShow2 played, CustomShow3 played, CustomShow1 played etc. I have a few ideas but its not turning out the way I want. Does anybody know how to accomplish this? Thanks |
#2
|
|||
|
|||
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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Sr. Citizen Question, Please: WORD Shows Blank, But Notepad Shows "Gibberish" ? | Robert11 | Word | 3 | 08-12-2013 12:35 PM |
Linking to custom shows | Jbee | PowerPoint | 1 | 10-09-2012 09:24 AM |
Page number XII, TOC shows 12 | SQLUSA | Word | 24 | 08-14-2012 05:38 PM |
Multiple shows on one slide | LWachter | PowerPoint | 1 | 12-24-2010 10:45 AM |
list of documents come up in random order - any ideas how to sort this? | tallscot49 | Word | 0 | 07-18-2010 12:40 AM |