SlideShowWindows错误（整数超出范围）

Question

我正在使用VBA脚本控制器在PowerPoint上准备测验。我的目标是设置多个问题，每个问题都有4个选择。

我尝试运行时设置了所有内容（从方法开始：＆＃34; BeginQuiz＆＃34;）它被以下错误打断：

  

SlideShowWindows（未知号码）整数超出范围

我的代码如下：

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