D
David N
I've been trying to get this working, but I am obviously
doing something basically wrong.
I am trying to build a template for a 'Memory' game to use
with students, based on the TV show 'Concentration'. The
main screen has 36 action buttons in a grid, with a rebus
puzzle behind them. Contestants choose first one button,
then a second one which they think is the matching picture
to the first. If they are correct, 'Match!!!' is
displayed, and the grid redisplays, but with the two
matching action buttons invisible, thus revealing part of
the underlying puzzle. If they are incorrect, the grid
redisplays, ready for the next contestant.
I've set up 38 slides. #s 1-36 are the picture pairs.
Under each picture is a button ('Done') with the action
set to run Sub 'Done'. #37 is the grid of action buttons.
Each action button has text being a number from 1-36, is
named with its number, and is set to run
Sub 'ButtonClick'. #38 Has text that says 'Match!!!', and
a button that is set to run Sub 'AfterMatch'.
Running the show, when I click a button, nothing happens.
(I want it to display the slide with the same number as
the button).
I would like to continue work on this to somehow keep
score of the contestant's matches, but there's no point of
even trying, since I can't get the basic show to work
correctly.
Here is my code:
Public vChoiceNumber As Integer
Public vButton1 As Integer
Public vButton2 As Integer
Public vPicName1 As String
Public vPicName2 As String
Public GoToSlideNumber As Integer
Sub Intialize()
ActivePresentation.SlideShowWindow.View.GotoSlide (38)
vPicName1 = ""
vPicName2 = ""
vButton1 = ""
vButton2 = ""
GoToSlideNumber = ""
vChoiceNumber = ""
End Sub
Sub ButtonClick(oShape As Shape)
If ChoiceNumber = "" Then
vButton1 = oShape.Name
ChoiceNumber = "1"
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
False 'to prevent puzzle from showing during screen redraw
on return to slide
GoToSlideNumber = vButton1
ActivePresentation.SlideShowWindow.View.GotoSlide
(GoToSlideNumber)
vPicName1 =
ActivePresentation.SlideShowWindow.View.Slide.Shapes
(2).Name
ElseIf ChoiceNumber = "1" Then
vButton2 = oShape.Name
ChoiceNumber = "2"
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
False
GoToSlideNumber = vButton2
ActivePresentation.SlideShowWindow.View.GotoSlide
(GoToSlideNumber)
vPicName2 =
ActivePresentation.SlideShowWindow.View.Slide.Shapes
(2).Name
End If
End Sub
Sub Done()
'
' Macro created 5/31/04 by DocuMed
'
If ChoiceNumber = "1" Then
ActivePresentation.SlideShowWindow.View.GotoSlide (38)
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
True
ElseIf ChoiceNumber = "2" Then
If vPicName1 = vPicName2 Then
ActivePresentation.SlideShowWindow.View.GotoSlide
(39)
ElseIf vButton1 <> vButton2 Then
ActivePresentation.SlideShowWindow.View.GotoSlide
(38)
ActivePresentation.Slides(38).Shapes
(puzzle).Visible = True
End If
ChoiceNumber = ""
End If
End Sub
Sub AfterMatch()
ActivePresentation.Slides(38).Shapes
(vButton1).Visible = False
ActivePresentation.Slides(38).Shapes
(vButton2).Visible = False
ActivePresentation.Slides(38).Shapes
(puzzle).Visible = True
vPicName1 = ""
vPicName2 = ""
vButton1 = ""
vButton2 = ""
End Sub
Sub NameShape() 'This is for setup, to name shapes
Dim Name$
On Error GoTo AbortNameShape
If ActiveWindow.Selection.ShapeRange.Count = 0 Then
MsgBox "No Shapes Selected"
Exit Sub
End If
Name$ = ActiveWindow.Selection.ShapeRange(1).Name
Name$ = InputBox$("Give this shape a name", "Shape Name",
Name$)
If Name$ <> "" Then
ActiveWindow.Selection.ShapeRange(1).Name = Name$
End If
Exit Sub
AbortNameShape:
MsgBox Err.Description
End Sub
doing something basically wrong.
I am trying to build a template for a 'Memory' game to use
with students, based on the TV show 'Concentration'. The
main screen has 36 action buttons in a grid, with a rebus
puzzle behind them. Contestants choose first one button,
then a second one which they think is the matching picture
to the first. If they are correct, 'Match!!!' is
displayed, and the grid redisplays, but with the two
matching action buttons invisible, thus revealing part of
the underlying puzzle. If they are incorrect, the grid
redisplays, ready for the next contestant.
I've set up 38 slides. #s 1-36 are the picture pairs.
Under each picture is a button ('Done') with the action
set to run Sub 'Done'. #37 is the grid of action buttons.
Each action button has text being a number from 1-36, is
named with its number, and is set to run
Sub 'ButtonClick'. #38 Has text that says 'Match!!!', and
a button that is set to run Sub 'AfterMatch'.
Running the show, when I click a button, nothing happens.
(I want it to display the slide with the same number as
the button).
I would like to continue work on this to somehow keep
score of the contestant's matches, but there's no point of
even trying, since I can't get the basic show to work
correctly.
Here is my code:
Public vChoiceNumber As Integer
Public vButton1 As Integer
Public vButton2 As Integer
Public vPicName1 As String
Public vPicName2 As String
Public GoToSlideNumber As Integer
Sub Intialize()
ActivePresentation.SlideShowWindow.View.GotoSlide (38)
vPicName1 = ""
vPicName2 = ""
vButton1 = ""
vButton2 = ""
GoToSlideNumber = ""
vChoiceNumber = ""
End Sub
Sub ButtonClick(oShape As Shape)
If ChoiceNumber = "" Then
vButton1 = oShape.Name
ChoiceNumber = "1"
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
False 'to prevent puzzle from showing during screen redraw
on return to slide
GoToSlideNumber = vButton1
ActivePresentation.SlideShowWindow.View.GotoSlide
(GoToSlideNumber)
vPicName1 =
ActivePresentation.SlideShowWindow.View.Slide.Shapes
(2).Name
ElseIf ChoiceNumber = "1" Then
vButton2 = oShape.Name
ChoiceNumber = "2"
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
False
GoToSlideNumber = vButton2
ActivePresentation.SlideShowWindow.View.GotoSlide
(GoToSlideNumber)
vPicName2 =
ActivePresentation.SlideShowWindow.View.Slide.Shapes
(2).Name
End If
End Sub
Sub Done()
'
' Macro created 5/31/04 by DocuMed
'
If ChoiceNumber = "1" Then
ActivePresentation.SlideShowWindow.View.GotoSlide (38)
ActivePresentation.Slides(38).Shapes(puzzle).Visible =
True
ElseIf ChoiceNumber = "2" Then
If vPicName1 = vPicName2 Then
ActivePresentation.SlideShowWindow.View.GotoSlide
(39)
ElseIf vButton1 <> vButton2 Then
ActivePresentation.SlideShowWindow.View.GotoSlide
(38)
ActivePresentation.Slides(38).Shapes
(puzzle).Visible = True
End If
ChoiceNumber = ""
End If
End Sub
Sub AfterMatch()
ActivePresentation.Slides(38).Shapes
(vButton1).Visible = False
ActivePresentation.Slides(38).Shapes
(vButton2).Visible = False
ActivePresentation.Slides(38).Shapes
(puzzle).Visible = True
vPicName1 = ""
vPicName2 = ""
vButton1 = ""
vButton2 = ""
End Sub
Sub NameShape() 'This is for setup, to name shapes
Dim Name$
On Error GoTo AbortNameShape
If ActiveWindow.Selection.ShapeRange.Count = 0 Then
MsgBox "No Shapes Selected"
Exit Sub
End If
Name$ = ActiveWindow.Selection.ShapeRange(1).Name
Name$ = InputBox$("Give this shape a name", "Shape Name",
Name$)
If Name$ <> "" Then
ActiveWindow.Selection.ShapeRange(1).Name = Name$
End If
Exit Sub
AbortNameShape:
MsgBox Err.Description
End Sub