Sub procedure to end "stop" another sub procedure

P

Preschool Mike

I'm trying to create a game for my preschool class where they have to
identify a certain number of shapes within a limited amount of time. I've
designed the "wait" procedure from David Marcovitz book (Powerful PowerPoint
for Educators) as my timer. Here is my design: I have 9 slides. The timer
is on the master slide so it shows up on all slides. Slide 1 has all the
shapes including the start game button, which starts the timer and plays a
sound on which shape to identify. When the student clicks on the correct
shape it plays a sound on the next shape to identify and advances to the next
slide and so on. If the student is not able to identify all the shapes
before the time runs out a picture appears (explosion) and the game ends, but
if they are able to identify all the shapes a shape appears on the last slide
anouncing they win. I'd like to have the last shape that they need to
identify (aftter click) to advance to the last slide, stop my countdown, and
display the shape that says they win. I'd also like for both (win or loose)
to play a sound at the end if possible.

Here is a sample of my code:
Sub Wait(waitTime As Long)

Start = Timer
While Timer < Start + waitTime
DoEvents
Wend
End Sub

Sub CountDown()
Initialize

ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"10"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"9"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"8"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"7"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"6"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"5"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"4"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"3"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"2"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"1"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"Out of Time"
ActivePresentation.SlideMaster.Shapes("explosion").Visible = True
End Sub

Sub Initialize()
ActivePresentation.SlideMaster.Shapes("explosion").Visible = False
End Sub

Sub NextShape()
ActivePresentation.SlideShowWindow.View.Next
End Sub

Any help is appreciated or suggestions on an alternative way to accomplish
what I'm trying to do.

Thanks,

Mike
 
P

Preschool Mike

Thanks for your help, although I'm still running into problems. Here is all
my code with quotes in my trouble spots. Could you plese take a look,
perhaps my code is wrong or maybe a better way.

Public StopNow As Boolean



Sub Wait(waitTime As Long)
Start = Timer
While Timer < Start + waitTime
'This works great the first time I run it but my countdown does not work
the next time I play the game
If StopNow Then
Exit Sub
Else
DoEvents
End If
Wend
End Sub

Sub CountDown()
'I've put the countdown clock on the master slide so it appears on all slides
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"20"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"19"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"18"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"17"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"16"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"15"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"14"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"13"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"12"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"11"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"10"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"9"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"8"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"7"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"6"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"5"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"4"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"3"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"2"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"1"
Wait (1)
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"0"
'This is where I would like something to happen when the countdown reaches "0"
'Preferabbly a "buzz" sound to play and picture displaying and explosion.
'I don't know how to write the code to play the sound and since I don't know
which slide they will be on when the time runs out
'I don't know how to write the code for the picture. Originally I had a
picture on the master slide that worked when the count
'reached "0" but when I ran the StopClock procedure, which runs StopNow the
picture still shows up on my winning slide. I
'tried setting the picture properties to False in the StopClock procedure
but that still did not work.
End Sub


Sub NextShape()
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub StopClock()
StopNow = True
ActivePresentation.SlideShowWindow.View.Next
'When the student clicks on the last shape to be identified the clock should
stop and then proceed to the next silde
'which indicates that they won the game
End Sub
 
P

Preschool Mike

The code works great, but if I win the game I still get the MsgBox saying I'm
out of time. Here's my revised code:
Option Explicit

Public StopNow As Boolean

Sub Wait(waitTime As Long)
Dim start As Double
start = Timer
While Timer < start + waitTime

If StopNow Then
Exit Sub
Else
DoEvents
End If
Wend
End Sub

Sub CountDown()

Dim X As Long
StopNow = False

For X = 20 To 0 Step -1
If Not StopNow Then

ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
CStr(X)
SlideShowWindows(1).View.GotoSlide
(SlideShowWindows(1).View.Slide.SlideIndex)
Wait (1)
End If
Next
MsgBox ("You're out of time!")
End Sub


Sub NextShape()
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub StopClock()
StopNow = True
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"20"
ActivePresentation.SlideShowWindow.View.Next
End Sub

Thanks again for you help and patience. I've only been at this for a few
months at best.

Mike
 
D

David Marcovitz

Mike,

You're in good hands with Steve. He has suggested everything I would have
suggested and more (even though I wrote the book, he knows more about VBA
than I do). I've only looked at this briefly, but it seems that your StopNow
variable is set to True when the student has identified all the shapes. If
that is the case, then the answer is quite easy. Just put an If statement
around MsgBox, something like:

If Not StopNow Then
MsgBox ("You're out of time!")
End If

If I am mistaken about StopNow, then you might need another more complex If
statement to determine if the student got everything and didn't run out of
time.

Once you get this working, I would love to put this on my Web site as an
example for others. If that's OK with you, please send it along to me
([email protected] - just delete the words "nospam"). Thanks.

--David

The code works great, but if I win the game I still get the MsgBox saying I'm
out of time. Here's my revised code:
Option Explicit

Public StopNow As Boolean

Sub Wait(waitTime As Long)
Dim start As Double
start = Timer
While Timer < start + waitTime

If StopNow Then
Exit Sub
Else
DoEvents
End If
Wend
End Sub

Sub CountDown()

Dim X As Long
StopNow = False

For X = 20 To 0 Step -1
If Not StopNow Then

ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
CStr(X)
SlideShowWindows(1).View.GotoSlide
(SlideShowWindows(1).View.Slide.SlideIndex)
Wait (1)
End If
Next
MsgBox ("You're out of time!")
End Sub


Sub NextShape()
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub StopClock()
StopNow = True
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
"20"
ActivePresentation.SlideShowWindow.View.Next
End Sub

Thanks again for you help and patience. I've only been at this for a few
months at best.

Mike
Click to expand...

--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland
 
P

Preschool Mike

That worked out perfectly. I'm honored to allow you to put this on your web
site. Will be sending it your way today. The project is called: Identifying
Shapes - Beat the clock.
 
P

Preschool Mike

Thanks for all your help. David suggestion of putting an If statement before
the mgsbox was the tip I needed. Your code really works great. I even added
a little to it allowing for the user to setup their own clock time. Here's
the final product if you're interested.

Option Explicit

Public StopNow As Boolean
Dim GameTime As Integer
Dim userName As String
Sub YourName()
userName = InputBox("Enter your name")
End Sub

Sub EnterTime()
YourName
GameTime = InputBox("Set the game time")
ActivePresentation.SlideShowWindow.View.Next
CountDown
End Sub
Sub Wait(waitTime As Long)
Dim start As Double
start = Timer
While Timer < start + waitTime

If StopNow Then
Exit Sub
Else
DoEvents
End If
Wend
End Sub

Sub CountDown()

Dim X As Long
StopNow = False

For X = GameTime To 0 Step -1
If Not StopNow Then

ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
CStr(X)
SlideShowWindows(1).View.GotoSlide
(SlideShowWindows(1).View.Slide.SlideIndex)
Wait (1)
End If
Next

If Not StopNow Then
MsgBox ("You're out of time!")
End If
End Sub


Sub NextShape()
ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub StopClock()
StopNow = True
ActivePresentation.SlideMaster.Shapes("Timebox").TextFrame.TextRange.Text =
userName
ActivePresentation.Slides(10).Shapes("WinnerBox").TextFrame.TextRange.Text =
"You Win " & userName
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Quit()
ActivePresentation.Close
End Sub
 
D

David Marcovitz

This example is now available on my Web site:

<http://www.PowerfulPowerPoint.com/>

Currently, it is the first example under "Examples from Real People," but I
hope to add some more examples soon so it might get bumped from its #1 spot
in the next few days.

--David

That worked out perfectly. I'm honored to allow you to put this on your web
site. Will be sending it your way today. The project is called: Identifying
Shapes - Beat the clock.
Click to expand...

--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Adjust my countodwn 4
value in text box 3
Generate 12 random numbers 13
Random numbers, letters, pictures? 6
Shapes appear then disappear then appear again? What's happening? 7
From excel columns to ppt textbox 0
Help with running 2 Macros simultaneously 1
text boxes to shapes 6

Top