I got a presentation that has multi choice questions where the last slide
displays the number of questions the user got right. I want to put a button
on that last slide, that when clicked, sends that slide or the whole
presentation back to me. The code is below and I want to know what to add to
the bottom to make it do that.
Const NOOFQS = 11
'Used to manipulated the unicode values of bulleted lists
Const UD_CODE_1 = 111
Const UD_CODE_2 = 8226
Public QNo As Integer
Public ExitFlag As Boolean
Public Qs() As String
Public Choices() As String
Public Ans() As Integer
Public UserAns() As Integer
Sub NextSlide()
' Store the ans for later
'UserAns(QNo - 1) = 1
If QNo < NOOFQS Then
QNo = QNo + 1
SlideShowWindows(1).Presentation.Slides("QSlide").Shapes(1).TextFrame.TextRa
nge.Text = Qs(QNo - 1)
AssignValues
Else
Call StopQuiz
End If
DoEvents
End Sub
Sub PreviousSlide()
Static X As Integer
If QNo > 1 Then
QNo = QNo - 1
AssignValues
End If
End Sub
Sub StopQuiz(Optional EndType As Boolean = False)
' EndType is used as a boolean Flag to indicate whether the user ran out of
time
' or whether it was normal exit
Dim ScoreCard As Integer
Dim Ctr As Integer
ExitFlag = True
With SlideShowWindows(1)
For Ctr = 0 To NOOFQS - 1
If Ans(Ctr) = UserAns(Ctr) Then ScoreCard = ScoreCard + 1
Next Ctr
..Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text
= "Your score is : " & ScoreCard & " correct out of " & NOOFQS
.View.GotoSlide (.Presentation.Slides("EndSlide").SlideIndex)
End With
End Sub
Sub StopIt()
Call StopQuiz(True)
End Sub
Sub BeginQuiz()
Dim Ctr As Integer
ReDim Qs(NOOFQS)
ReDim Ans(NOOFQS)
ReDim UserAns(NOOFQS)
ReDim Choices(NOOFQS, 3)
' All the questions and answers taken out
Qs(0) = "1) "
Qs(1) = "2) "
Qs(2) = "3) "
Qs(3) = "4) "
Qs(4) = "5) "
Qs(5) = "6) "
Qs(6) = "7) "
Qs(7) = "8) "
Qs(8) = "9) "
Qs(9) = "10) "
Qs(10) = "11) "
' Set all user answers to negative
For Ctr = 0 To NOOFQS - 1
UserAns(Ctr) = -1
Next Ctr
' All the choices 3 each for a question
Choices(0, 0) = " "
Choices(0, 1) = " "
Choices(0, 2) = " "
Choices(1, 0) = " "
Choices(1, 1) = " "
Choices(1, 2) = " "
Choices(2, 0) = " "
Choices(2, 1) = " "
Choices(2, 2) = " "
Choices(3, 0) = " "
Choices(3, 1) = " "
Choices(3, 2) = " "
Choices(4, 0) = " "
Choices(4, 1) = " "
Choices(4, 2) = " "
Choices(5, 0) = " "
Choices(5, 1) = " "
Choices(5, 2) = ""
Choices(6, 0) = " "
Choices(6, 1) = " "
Choices(6, 2) = " "
Choices(7, 0) = " "
Choices(7, 1) = " "
Choices(7, 2) = " "
Choices(8, 0) = " "
Choices(8, 1) = " "
Choices(8, 2) = " "
Choices(9, 0) = " "
Choices(9, 1) = " "
Choices(9, 2) = " "
Choices(10, 0) = " "
Choices(10, 1) = " "
Choices(10, 2) = " "
Ans(0) = 0
Ans(1) = 1
Ans(2) = 1
Ans(3) = 2
Ans(4) = 0
Ans(5) = 1
Ans(6) = 2
Ans(7) = 1
Ans(8) = 2
Ans(9) = 0
Ans(10) = 2
Ans(9) = 0
QNo = 1
AssignValues
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides("QSlide").SlideIndex)
End With
End Sub
Sub SetBulletUnicode(ShapeName As String, Code As Integer)
With
SlideShowWindows(1).Presentation.Slides("QSlide").Shapes(ShapeName).TextFram
e.TextRange.ParagraphFormat.Bullet
.UseTextFont = msoTrue
.Character = Code
End With
End Sub
Sub ButtonChoice1()
UserAns(QNo - 1) = 0
AssignValues
End Sub
Sub ButtonChoice2()
UserAns(QNo - 1) = 1
AssignValues
End Sub
Sub ButtonChoice3()
UserAns(QNo - 1) = 2
AssignValues
End Sub
Sub AssignValues()
SetBulletUnicode "Choice1", UD_CODE_1
SetBulletUnicode "Choice2", UD_CODE_1
SetBulletUnicode "Choice3", UD_CODE_1
Select Case UserAns(QNo - 1)
Case 0
SetBulletUnicode "Choice1", UD_CODE_2
Case 1
SetBulletUnicode "Choice2", UD_CODE_2
Case 2
SetBulletUnicode "Choice3", UD_CODE_2
End Select
With SlideShowWindows(1).Presentation.Slides("QSlide")
.Shapes(1).TextFrame.TextRange.Text = Qs(QNo - 1)
.Shapes("Choice1").TextFrame.TextRange.Text = Choices(QNo - 1, 0)
.Shapes("Choice2").TextFrame.TextRange.Text = Choices(QNo - 1, 1)
.Shapes("Choice3").TextFrame.TextRange.Text = Choices(QNo - 1, 2)
End With
End Sub
Sub Send Email()
??
End Sub
