Either it reaches a specific time (this will be entered at the beginning of the script by the user, but is likely to be 19:20)
OR it displays for a specific amount of time (this will only occur if it is far enough away from the time described above that it is unrealistic to want it to run for that long)
OR the user presses 'Escape'.
I have come quite far with the coding, but I can't seem to get the SlideShow to advance from one slide to the next at all, it will just sit there on Slide 1
Please take careful note that this is vbScript I'm using, NOT VBA. Here are the relevant sections of coding:
''''''''''''''''''''''''''''''
Function GoSleep(minutes)
'Get the specified time for start of play
endMin = Minute(StartTime) + 5
endHour = Hour(StartTime)
If Hour(Now()) > endHour Or Hour(Now()) < endHour - 1 Then
WScript.Sleep(minutes * 60000)
' MsgBox("TEST: Far away")
ElseIf Hour(Now()) = endHour And Minute(Now()) > endMin Then
WScript.Sleep(minutes * 60000)
' MsgBox("TEST: Close but over")
Else
sleep = ((endHour - Hour(Now()))*60) - Minute(Now()) + endMin
WScript.Sleep(sleep * 60000)
' MsgBox("TEST: Bingo!")
End If
End Function
'''''''''''''''''''''''''''''''
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set ActivePresentation = objPPT.Presentations.Add
ppShowAll = 1
ppSlideShowUseSlideTimings = 2
ppShowTypeKiosk = 3
ppEffectRandom = 513
ppEffectAppear = 3844
ppEffectWipeDown = 2820
''' Random coding that creates 1, 2 or 3 slides with one table on each
'''This part works fine
'''I have tried several variants of coding to get the next bit to work, but to no avail
'''Attempt 1'''
' Setup slide show properties.
With ActivePresentation.Slides.Range.SlideShowTransition
.EntryEffect = ppEffectWipeDown
.AdvanceOnTime = msoTrue
.AdvanceTime = 9 ' 9 seconds per slide
End With
' Prepare and run the slide show.
With ActivePresentation.SlideShowSettings
.ShowType = ppShowTypeKiosk
.LoopUntilStopped = msoTrue
.RangeType = ppShowAll
.AdvanceMode = ppSlideShowUseSlideTimings
.Run
End With
'''End of Attempt 1 - removed from coding'''
'''Would not advance, even by left-clicking on screen'''
'''Attempt 2'''
For Each s In ActivePresentation.Slides
With s.SlideShowTransition
.AdvanceOnTime = msoTrue
.AdvanceTime = 9
End With
Next
With ActivePresentation.SlideShowSettings
.RangeType = ppShowAll
.AdvanceMode = ppSlideShowUseSlideTimings
.LoopUntilStopped = True
.Run
End With
'''End of Attempt 2 - removed from coding'''
'''Would advance via click, but not automatically'''
' Sleep so user can watch the show.
GoSleep(1.5)
' In case I decide to remove the Save option
'ActivePresentation.Saved = True
ActivePresentation.SaveAs FileSaveName
ActivePresentation.Close
objPPT.Quit



Help
Back to top








