Jump to content

MS PowerPoint 2007 automation via vbScript


Pebbles28

Recommended Posts

Hi there. I'm having some problems with getting my script to do what I want it to do. I have created a PowerPoint presentation and now I want my script to play it on a loop until one of three things happens.

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

Link to comment
Share on other sites


Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...