SlideShowWindows error (integer out of range) - vba

Question

I'm preparing a quiz using on PowerPoint using the controllers of VBA scripts. My aim to set multiple questions, each has 4 choices.
I've set everything, when trying to run (starting with the method: "BeginQuiz") it's interrupted by the following error:
SlideShowWindows (unknown number) Integer out of range
My code is below:
Const NOOFQS = 4
'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.TextRange.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
If EndType = False Then
.Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text = "Your score is : " & ScoreCard & " correct out of " & NOOFQS
Else
.Presentation.Slides("EndSlide").Shapes("Closing").TextFrame.TextRange.Text = "Sorry!!! Either you ran out of time or you chickened out" _
& vbCrLf & "Better luck next time." & vbCrLf _
& "Your score is: " & ScoreCard & " correct out of " & NOOFQS
End If
.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, 4)
' All the questions
Qs(0) = "1) ãä Ãæá ãä ÝÊÍ ÇáÞÏÓ ÈÚÏ ÚãÑ¿"
Qs(1) = "2) ãä åí Ãæá ãä ÃÓáãÊ ãä ÇáäÓÇÁ¿"
Qs(2) = "3) ãÇ åí ÇáãäØÞÉ ÇáÊí ÍÑÑåÇ ãÍãÏ ÇáÝÇÊÍ¿"
Qs(3) = "4) ãÇ åæ Ãæá ãÓÌÏ Ýí ÇáÅÓáÇã¿"
' 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(0, 3) = " ÇáÙÇåÑ ÈíÈÑÓ"
Choices(1, 0) = " ÃÓãÇÁ ÈäÊ ÃÈí ÈßÑ "
Choices(1, 1) = " ÓæÏÉ ÈäÊ ÒãÚÉ "
Choices(1, 2) = " ÎÏíÌÉ ÈäÊ ÎæíáÏ "
Choices(1, 3) = " Ãã ÚãÇÑ Èä íÇÓÑ "
Choices(2, 0) = " ØáíØáÉ "
Choices(2, 1) = " ÇáÞÇÏÓíÉ "
Choices(2, 2) = " ÇáÞÓØäØíäíÉ "
Choices(2, 3) = " ÇáÃäÏáÓ"
Choices(3, 0) = " ãÓÌÏ ÞÈÇÁ"
Choices(3, 1) = " ãÓÌÏ Ðí ÇáäæÑíä"
Choices(3, 2) = " ÇáãÓÌÏ ÇáäÈæí"
Choices(3, 3) = " ÇáÈíÊ ÇáÍÑÇã"
' Provide the answer list here.
' Ans(0) = 0 means that the correct answer to the 1st question is the 1st choice.
' Ans(1) = 1 means that the correct answer to the 2nd question is the 2nd choice.
' Ans(2) = 1 means that the correct answer to the 3rd question is the 2nd choice.
Ans(0) = 0
Ans(1) = 2
Ans(2) = 2
Ans(3) = 0
QNo = 1
AssignValues
With SlideShowWindows(1)
.View.GotoSlide (.Presentation.Slides("QSlide").SlideIndex)
End With
' Comment the line below to stop the timer.
Call Tmr
End Sub
Sub SetBulletUnicode(ShapeName As String, Code As Integer)
With SlideShowWindows(1).Presentation.Slides("QSlide").Shapes(ShapeName).TextFrame.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 Tmr()
'Just in the eventuality that you click the start button twice
'isRunning stores the current state of the macro
'TRUE = Running; FALSE = Idle
ExitFlag = False
Static isRunning As Boolean
If isRunning = True Then
End
Else
isRunning = True
Dim TMinus As Integer
Dim xtime As Date
xtime = Now
With ActivePresentation.Slides(2).Shapes("Timer")
'Countdown in seconds
TMinus = 59
Do While (TMinus > -1)
DoEvents
' Rather crude way to determine if a second has elapsed
If ExitFlag = True Then
.TextFrame.TextRange.Text = "00:00:00"
isRunning = False
Exit Sub
End If
If Format(Now, "ss") <> Format(xtime, "ss") Then
xtime = Now
.TextFrame.TextRange.Text = Format(TimeValue(Format(Now, "hh:mm:ss")) - _
TimeSerial(Hour(Now), Minute(Now), Second(Now) + TMinus), "hh:mm:ss")
TMinus = TMinus - 1
' Let the display refresh itself
End If
Loop
End With
Debug.Print "came here"
isRunning = False
StopQuiz True
End
End If
End Sub
Sub AssignValues()
SetBulletUnicode "Choice1", UD_CODE_1
SetBulletUnicode "Choice2", UD_CODE_1
SetBulletUnicode "Choice3", UD_CODE_1
SetBulletUnicode "Choice4", 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
Case 3
SetBulletUnicode "Choice4", 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)
.Shapes("Choice4").TextFrame.TextRange.Text = Choices(QNo - 1, 3)
End With
End Sub
Sub ShowAnswers()
Dim AnsList As String
AnsList = "The answers are as follows:" & vbCrLf
For X = 0 To NOOFQS - 1
AnsList = AnsList & Qs(X) & vbTab & " Answer:" & Choices(X, Ans(X)) & vbCrLf
Next X
MsgBox AnsList, vbOKOnly, "Correct answers"
End Sub