A majority of the code for the Math Game program is still located in the same worksheet module as the original program from Chapter 4. Once the test begins, the algorithm is pretty much the same, but instead of generating problems randomly, they are read from the Create_Edit_Tests worksheet. Since the algorithm and much of the code is nearly the same as the program from Chapter 4, I will limit the discussion to the new sections of the program.
Before a test begins, a student must sign in by selecting their name from the Combo Box control which triggers its Change() event.
Private curQuestion As Integer Private numQuestions As Integer Private curDate As Date Private gameRunning As Boolean Private curStudent As String
I use the Change() event procedure to initialize variables and the appearance of the worksheet, after which the appropriate test for the student (according to their level) is loaded into the Create_Edit_Tests worksheet.
Private Sub cmbStudents_Change() Dim fileName As String Dim studLevel As Integer Dim studRange As Range
If gameRunning Then Exit Sub ClearBoard
With Range("A2:C" & UsedRange.Rows.Count) .ClearContents .Font.Color = vbBlack End With
Range("B1").Value = cmbStudents.Value & "'s" & " Answer" curStudent = cmbStudents.Value
'Determine the test level for the selected student. i___________________________
Set studRange = Worksheets("Students").ListObjects("Students").Range studLevel = studRange(studRange.Find(What:=curStudent).Row, 2).Value
'Load a new exam when the student name is changed in combo box.
fileName = ActiveWorkbook.path & "\TestProperties\test" & studLevel & "p.xml" cmdBegin.Enabled = True OpenXMLFile fileName End Sub
Private Sub ClearBoard()
'Clears the operands and the answer from the worksheet cells.
Range("LeftOperand").Value = "" Range("RightOperand").Value = "" Range("Answer").Value = "" End Sub
The test begins with the triggering of the Click() event of the Command Button control labeled Begin. The questions are read from the Create_Edit_Tests worksheet. (Recall that the appropriate test is loaded into this worksheet after the user signs in.)
Instead of using index numbers with the ListObjects collection object, I prefer to use specific names for each ListObject; however, Excel assigns the names Listl, List2, and so on to each list as it is created. Therefore, to change a name to something meaningful, I select the worksheet containing the list(s) I want to name and then write a VBA procedure similar to the following:
Dim lo As ListObject For Each lo In ActiveSheet.ListObjects If lo.Name = "Listl" Then lo.Name = "Problems" End If
Next End Sub
This gives a meaningful name to the ListObject object that I can reference in my program to make it more self-documenting.
Setting the MoveAfterReturn property of the Application object to false ensures that the answer cell (merged range L8:M9) remains selected as the student enters his or her answers. Setting the Calculation property to manual prevents interference from Excel attempting to calculate the worksheet while the timer counts down. This isn't really necessary, but if you don't turn off the automatic calculation in a situation like this, you will probably see considerable screen flicker while the program executes.
Problems are written to the worksheet with a call to the GetProblem() sub procedure which reads individual problems from the Create_Edit_Tests worksheet and writes it to the appropriate cells on the Math Game worksheet. Next, the timer is started with a call to the MathGame() sub procedure.
Private Sub cmdBegin_Click() Dim qNumbers As Range
Set qNumbers = Worksheets("Create_Edit_Tests").ListObjects("Problems").Range
'Initialize variables and controls.
cmdBegin.Enabled = False gameRunning = True curQuestion = 1
numQuestions = qNumbers.Cells(qNumbers.Rows.Count, 1).Value Range("Answer").Select Application.MoveAfterReturn = False Application.Calculation = xlCalculationManual
'Get the first question.
'Mark the start time and start the clock.
curDate = Now MathGame End Sub
Private Sub GetProblem() Dim ws As Worksheet
'Reads the problem from the test worksheet and writes 'it to the cells in the Math Game worksheet.
Set ws = Worksheets("Create_Edit_Tests")
Range("LeftOperand").Value = ws.ListObjects("Problems").Range.Cells(curQuestion + 1, 2).Value
Range("Operator").Value = ws.ListObjects("Problems").Range.Cells(curQuestion + 1, 3).Value
Range("RightOperand").Value = ws.ListObjects("Problems").Range.Cells(curQuestion + 1, 4).Value curQuestion = curQuestion + 1 End Sub
The MathGame() procedure contains the call to the OnTime() method of the Application object and sets the schedule for this procedure to be called every second. The allotted time for a test is read from the Create_Edit_Tests worksheet. The OnTime() method is cancelled when the timer reaches zero or the student answers every test question. After the test is over, the results are scored, variables and properties are reset, and the student's level is increased by one if they score 100%.
Private Sub MathGame()
'Manages the clock while testing. Calls scoring procedures when test is over. Dim numSeconds As Integer Dim nextTime As Date Dim timeAllowed As Integer Dim newLevel As Boolean
On Error GoTo TimingError timeAllowed = Worksheets("Create_Edit_Tests").Range("C2").Value numSeconds = DateDiff("s", curDate, Now)
'Start the clock.
Range("Clock").Value = timeAllowed - numSeconds nextTime = Now + TimeValue("00:00:01") Application.OnTime EarliestTime:=nextTime, Procedure:="MathGameSheet.MathGame", Schedule:=True
'Disable timer when it reaches zero, score results, and clean up 'worksheet controls/cells.
If (timeAllowed - numSeconds <= 0) Or (curQuestion >= (numQuestions + 2)) Then Application.OnTime EarliestTime:=nextTime, Procedure:="MathGameSheet.MathGame", Schedule:=False cmbStudents.Value = "" ClearBoard
If curQuestion < numQuestions Then
WriteRemainingProblems End If newLevel = ScoreAnswers StoreResults
If newLevel Then IncrementStudentLevel Application.MoveAfterReturn = True Application.Calculation = xlCalculationAutomatic gameRunning = False End If Exit Sub
MsgBox "An error occurred with the game timer." & vbCrLf & Err.Description _ , vbOKOnly, "Timer Error: " & Err.Number
Student answers to questions are captured from the Change() event of the Worksheet object which is triggered when an answer is entered (student presses the Enter key on the keyboard). After the answer is collected, the next question is written to the Math Game worksheet with another call to the GetProblem() sub procedure. Problems and the student's answer are written to the report area of the worksheet before the answer is cleared from the problem area.
Private Sub Worksheet_Change(ByVal Target As Range)
'Copies question and answer entered by the user to the 'report area and gets the next question.
If (Target.Address = "$L$8") And (Range("Answer").Value <> "") And gameRunning
Range("A" & curQuestion).Value = Range("LeftOperand").Value & _
Range("Operator").Value & Range("RightOperand").Value Range("B" & curQuestion).Value = Range("Answer").Value GetProblem
Range("Answer").Value = "" End If End Sub
If the student fails to finish the test, the remaining unanswered questions are written to the report area of the Math Game worksheet with a call to the WriteRemainingProblems() sub procedure. This procedure is called from the MathGame() sub procedure listed earlier.
Private Sub WriteRemainingProblems() Dim qRange As Range Dim c As Range
'Writes questions not answered by student to the report area.
Set qRange = Worksheets("Create_Edit_Tests").ListObjects("Problems").Range For Each c In Range("A" & curQuestion & ":A" & numQuestions + 1) c.Value = qRange.Cells(curQuestion, 2).Value c.Value = c.Value & qRange.Cells(curQuestion, 3).Value c.Value = c.Value & qRange.Cells(curQuestion, 4).Value curQuestion = curQuestion + 1
You may recall that in the Math Game program from Chapter 4, I used arrays to hold the problems and answers as they were generated by the program. That's no longer necessary since the problems are listed in a worksheet. This makes scoring a student's test a little easier since all I have to do is read an answer from the Create_Edit_Tests worksheet and compare it to the student's answer listed in column B of the Math Game worksheet. Note that the ScoreAnswers() function procedure returns a Boolean value to the calling procedure indicating whether or not the student scored 100 percent on the test.
Private Function ScoreAnswers() As Boolean Dim I As Integer Dim numWrong As Integer Dim ws As Worksheet Dim c As Range
'After the test is over, the user's answers are scored and the 'results written to the worksheet.
Set ws = Worksheets("Create_Edit_Tests") I = 1
For Each c In Range("C2:C" & curQuestion - 1)
c.Value = ws.ListObjects("Problems").Range.Cells(I + 1, 5).Value If (c.Value <> Range("B" & c.Row).Value) Or (Range("B" & c.Row).Value = "") Then Range("B" & c.Row).Font.Color = RGB(255, 0, 0) numWrong = numWrong + 1
Range("B" & c.Row).Font.Color = RGB(0, 0, 0) End If I = I + 1
'Compute % correct and write to the worksheet.
Cells(I + 1, "A").Value = "Score (%)" Cells(I + 1, "B").Font.Color = RGB(0, 0, 0)
Cells(I + 1, "B").Formula = "=" & (I - 1 - numWrong) / (I - 1) & "*100" If Cells(I + 1, "B").Value = 100 Then ScoreAnswers = True End Function
The StoreResults() sub procedure writes individual test results to the Students worksheet and the XML document file (results.xml). First, the appropriate ListObject object is made active before the student's name and score is added to the end of its list (determined using the InsertRowRange property). Note that I turned off the screen updating because I don't want to show the Students worksheet.
Since the XmlMap object already exists, it's a simple task to export the new results to the XML document file.
Private Sub StoreResults()
Dim studList As ListObject
Dim wsTest As Worksheet, wsStud As Worksheet, wsGame As Worksheet Dim mapResults As xmlMap Dim pathResults As String Dim nextRow As Integer
On Error GoTo StoreError
'Stores results of exam to XML file.
Set wsTest = Worksheets("Create_Edit_Tests") Set wsStud = Worksheets("Students") Set wsGame = Worksheets("Math Game") Set studList = wsStud.ListObjects("Results") If Not studList.Active Then
Application.ScreenUpdating = False wsStud.Activate studList.Range.Activate nextRow = studList.InsertRowRange.Row wsGame.Activate End If studList.Range.Cells(nextRow, 1).Value = curStudent studList.Range.Cells(nextRow, 2) = wsTest.Range("A2").Value studList.Range.Cells(nextRow, 3) = Cells(Range("A:A").Find(What:="Score").Row, 2).
Set mapResults = ActiveWorkbook.XmlMaps("results_Map") pathResults = ActiveWorkbook.path & "\TestResults\results.xml" If mapResults.IsExportable Then mapResults.Export URL:=pathResults, Overwrite:=True
MsgBox "XML map is not exportable!", vbOKOnly, "XML Map" End If Exit Sub
MsgBox "An error occurred while attempting to store the results." _ & vbCrLf & Err.Description, vbOKOnly, "Store Error: " & Err.Number
When a student scores 100 percent on a test, their level is increased by one so that the next time they sign in they are given the next test in the sequence. The IncrementStudentLevel() sub procedure (called from the MathGame() sub procedure if the student scored 100 percent) increments a student's level in the appropriate list in the Students worksheet and then updates the XML document file (students.xml) with a called to the UpdateStudentXml() sub procedure located in a standard module (listed earlier). The next test associated with the student's new level is then loaded in the worksheet.
Private Sub IncrementStudentLevel() Dim studList As ListObject Dim studLevel As Range Dim ws As Worksheet Dim fileName As String
On Error GoTo FileError
Set ws = Worksheets("Students")
'Increment the value in the worksheet.
Set studList = ws.ListObjects("Students")
Set studLevel = ws.Cells(studList.Range.Find(What:=curStudent).Row, 2) studLevel.Value = studLevel.Value + 1
'Save the xml file and load the new test.
UpdateStudentXml False fileName = ActiveWorkbook.path & "\TestProperties\test" & studLevel.Value & "p.xml"
OpenXMLFile fileName Exit Sub
MsgBox "The student's level was not increased." _
& vbCrLf & Err.Description, vbOKOnly, "IncrementStudentLevel: " & Err.Number
The last procedure listed is the Click() event of the Command Button control labeled Print. This procedure prints the report area of the Math Game worksheet (columns A through C) using the PrintOut() method of the Range object.
Private Sub cmdPrint_Click() Dim pRange As Range Dim lastRow As Integer
'Print the results of the test.
On Error GoTo PrintError lastRow = Range("A:A").Find(What:="", After:=Range("A1")).Row - 1 Set pRange = Range("A1:C" & lastRow) pRange.PrintOut Exit Sub
MsgBox Err.Description, vbOKOnly, "Printing Error " & Err.Number End End Sub
That concludes the revised version of the Math Game program. As usual, I left considerable room for improvement; some of these improvements are suggested as exercises in the Challenges section at the end of the chapter.
Was this article helpful?