It doesn't seem like you have given enough information. This is one
procedure that needs adjusting to add a fourth choice, but other things
need adjusting as well, such as adding a shape and naming it Choice4,
adding a ButtonChoice4 procedure and assigning it to the new shape, ...
Why don't you post all the code you have changed with a comment by each
change you made and list the other things you have done to add the fourth
choice (such as creating and naming new shapes). Otherwise, it will be
difficult to figure out which of the many things you have missed.
--David
--
David M. Marcovitz
Microsoft PowerPoint MVP
Director of Graduate Programs in Educational Technology
Loyola College in Maryland
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
@x35g2000prf.googlegroups.com:
- Show quoted text -
Here is the entire code.
Const NOOFQS = 6
'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 _
End If
.View.GotoSlide (.Presentation.Slides("EndSlide").SlideIndex)
End With
End Sub
Sub BeginQuiz()
Dim Ctr As Integer
ReDim Qs(NOOFQS)
ReDim Ans(NOOFQS)
ReDim UserAns(NOOFQS)
ReDim Choices(NOOFQS, 6)
' All the questions
Qs(0) = "Question #1" _
& vbCrLf & "Which window on the Home page contains the link for the
Saba Learner Guide?"
Qs(1) = "Question #2" _
& vbCrLf & "If an eLearning course states "Click Here to Access
eLearning" in the title, what section of the Course Details page
contains the link to start the eLearning? "
Qs(2) = "Question #3" _
& vbCrLf & "What window needs to be free of all learning items to show
that you are up-to-date on your training requirements?"
Qs(3) = "Question #4" _
& vbCrLf & "Read & Acknowledge documents are marked complete from the
_______ page?"
Qs(4) = "Question #5" _
& vbCrLf & "To view all of the learning items you have completed, what
text field do you need to delete?"
Qs(5) = "Question #6" _
& vbCrLf & "Which of the following actions CAN be completed from the
Enrollments page?"
' Set all user answers to negative
For Ctr = 0 To NOOFQS - 1
UserAns(Ctr) = -1
Next Ctr
' All the choices 4 each for a question
Choices(0, 0) = " Catalog Search"
Choices(0, 1) = " Current Enrollments"
Choices(0, 2) = " Saba Reference Materials"
Choices(0, 3) = " Certifications"
Choices(1, 0) = " Short Description"
Choices(1, 1) = " Attachments"
Choices(1, 2) = " Title"
Choices(1, 3) = " Prerequisites"
Choices(2, 0) = " Enrollments"
Choices(2, 1) = " Certifications"
Choices(2, 2) = " Curricula"
Choices(2, 3) = " Catalog Search"
Choices(3, 0) = " Enrollments"
Choices(3, 1) = " Transcripts"
Choices(3, 2) = " Curricula"
Choices(3, 3) = " Certifications"
Choices(4, 0) = " Completion Date before"
Choices(4, 1) = " Registration Date"
Choices(4, 2) = " Assigned Date"
Choices(4, 3) = " Completion Date after"
Choices(5, 0) = " Register"
Choices(5, 1) = " Drop"
Choices(5, 2) = " Search"
Choices(5, 3) = " None of the Above"
Ans(0) = 2
Ans(1) = 1
Ans(2) = 1
Ans(3) = 0
Ans(4) = 0
Ans(5) = 1
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).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 ButtonChoice4()
UserAns(QNo - 1) = 3
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 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
