VB help with creating a "Test" form with scoring

D

dsc2bjn

I have VERY LITTLE VB experience and inherited a form which had 20 questions.
I wish to modify the form to have 25 questions this year. I added the new
questions and modified the macro, but receive an error stating that the
object has been deleted.

Any help is greatly apprecieated!!

It errors out at:
If ActiveDocument.Variables(VarName).Value <> "0" Then
OneAnswerCheck
Else
ActiveDocument.Variables(VarName).Value = Mid(CurFFNm, 2, 1)
End If

I have included the full VB module below:

Sub SumTableRowCheckBoxes()
' MANAGEMENT CONTROL TEST AUTOMATION CODE
' NOTE: Form must stay in NORMAL VIEW, or it will continuously
' repaginate while calculations run, GREATLY slowing down
' the form and causing it to jump.
' There are Several procedures within this code:
' SumTableRowCheckBoxes
' Calculates totals for sections and whole form
' InitForm (not currently automatically run)
' Deselects any selected checkboxes
' Initializes the document variables to "0". These variables
' keep track of the checkboxes that have been selected, so that
' the program will know which checkboxes to deselect when
another
' selection is made.
'
' If someone accidently saves this file with boxes checked
' then InitForm can be run from the Immediate window, to clear
' out the form, and then save the form. You would do this
' by Tools, Macro, Visual Basic Editor, Control-G
' (to bring up the Immediate Window), and type:
' Call InitForm() (press Enter) in the Immediate Window.
' Then save the form.
' OneAnswerCheck
' Deselects the previously selected checkbox in a particular row
' when another selection is made for that row.
' LdOneAnswerCheck
' Determines if a selection has already been made on a
particular row
' (question) and if not, saves the column of the current
selection. If
' so, runs OneAnswerCheck which deselects the previous
selection for
' that row (question). This procedure, which runs every time a
checkbox
' is selected, is meant to minimize the amount of code that
runs every
' time a checkbox is chosen. The more substantial code, which
is in
' OneAnswerCheck, only runs when a user wants to change a
selection.
' GetValueFromName
' No longer used.
'
' This code uses the names that have been assigned to each field within this
form
' (each checkbox gets a name consisting of its section, such as "A" or "B",
its
' question, such as "1" or "2", and its column, such as "1" or "2", and each
textbox
' gets a name as well) to automate the form processing.

' NOTE: I left all of the question related checkboxes as Section B, even
though there
' is only 1 section now, to avoid having to rename everything, so question 4
selection A
' would be BA4
'ActiveDocument.FormFields("Message1").Result = "Calculating Score..."
Dim ffldsChkBoxes As Word.FormFields
Dim frmField As Word.FormField
Dim RunningCheckBoxSum As Integer
Dim frmSectA As Integer
Dim frmSectB As Integer
Dim frmFieldValStr As String
Dim frmFieldVal As Integer
Dim FrmFieldName As Variant
Dim v_null As String
ScreenUpdating = False

'This program reads through all the selected check box fields in the
'TMA vulnerability form, tallies the total score, section scores.
'The program uses the names that have been assigned to the checkbox fields
'to assign values to the fields.

If Selection.Information(wdWithInTable) = True Then
'Choose all of the FormFields in the Document
Set ffldsChkBoxes = ActiveDocument.FormFields
' Initialize
RunningCheckBoxSum = 0
frmSectA = 0
frmSectB = 0
ActiveDocument.FormFields("Message1").Result = "Calculating Score..."
For Each frmField In ffldsChkBoxes
If frmField.Type = wdFieldFormCheckBox Then
If frmField.CheckBox.Value = True Then
FrmFieldName = frmField.Name

Select Case FrmFieldName
' Increment score for each correctly answered question
Case "BB1"
frmSectB = frmSectB + 1
Case "BC2"
frmSectB = frmSectB + 1
Case "BB3"
frmSectB = frmSectB + 1
Case "BD4"
frmSectB = frmSectB + 1
Case "BC5"
frmSectB = frmSectB + 1
Case "BC6"
frmSectB = frmSectB + 1
Case "BC7"
frmSectB = frmSectB + 1
Case "BA8"
frmSectB = frmSectB + 1
Case "BA9"
frmSectB = frmSectB + 1
Case "BA10"
frmSectB = frmSectB + 1
Case "BB11"
frmSectB = frmSectB + 1
Case "BD12"
frmSectB = frmSectB + 1
Case "BB13"
frmSectB = frmSectB + 1
Case "BC14"
frmSectB = frmSectB + 1
Case "BC15"
frmSectB = frmSectB + 1
Case "BD16"
frmSectB = frmSectB + 1
Case "BA17"
frmSectB = frmSectB + 1
Case "BB18"
frmSectB = frmSectB + 1
Case "BB19"
frmSectB = frmSectB + 1
Case "BD20"
frmSectB = frmSectB + 1
Case "BA21"
frmSectB = frmSectB + 1
Case "BB22"
frmSectB = frmSectB + 1
Case "BC23"
frmSectB = frmSectB + 1
Case "BD24"
frmSectB = frmSectB + 1
Case "BB25"
frmSectB = frmSectB + 1
End Select
End If
End If
Next

Else
MsgBox "Any checkbox or formfield running this macro must be in a
table."
End If
'MsgBox ("CALCULATION IS COMPLETE.")

RunningCheckBoxSum = frmSectA + frmSectB
ActiveDocument.FormFields("Total").Result = RunningCheckBoxSum * 4
If RunningCheckBoxSum >= 20 Then
' Scored 80% or above so show answers to only questions missed
' Easiest way to do this is just to do multiple if/then statements
' Could do something at CASE statement, but would need to unset
variables
' for next run of program.
'Question 1
If ActiveDocument.FormFields("BA1").CheckBox.Value <> True Then
ActiveDocument.FormFields("B1Answer").Result = "B"
End If
'Question 2
If ActiveDocument.FormFields("BB2").CheckBox.Value <> True Then
ActiveDocument.FormFields("B2Answer").Result = "C"
End If
'Question 3
If ActiveDocument.FormFields("BC3").CheckBox.Value <> True Then
ActiveDocument.FormFields("B3Answer").Result = "B"
End If
'Question 4
If ActiveDocument.FormFields("BD4").CheckBox.Value <> True Then
ActiveDocument.FormFields("B4Answer").Result = "D"
End If
'Question 5
If ActiveDocument.FormFields("BD5").CheckBox.Value <> True Then
ActiveDocument.FormFields("B5Answer").Result = "C"
End If
'Question 6
If ActiveDocument.FormFields("BA6").CheckBox.Value <> True Then
ActiveDocument.FormFields("B6Answer").Result = "C"
End If
'Question 7
If ActiveDocument.FormFields("BD7").CheckBox.Value <> True Then
ActiveDocument.FormFields("B7Answer").Result = "C"
End If
'Question 8
If ActiveDocument.FormFields("BA8").CheckBox.Value <> True Then
ActiveDocument.FormFields("B8Answer").Result = "A"
End If
'Question 9
If ActiveDocument.FormFields("BC9").CheckBox.Value <> True Then
ActiveDocument.FormFields("B9Answer").Result = "B"
End If
'Question 10
If ActiveDocument.FormFields("BB10").CheckBox.Value <> True Then
ActiveDocument.FormFields("B10Answer").Result = "A"
End If
'Question 11
If ActiveDocument.FormFields("BB11").CheckBox.Value <> True Then
ActiveDocument.FormFields("B11Answer").Result = "B"
End If
'Question 12
If ActiveDocument.FormFields("BD12").CheckBox.Value <> True Then
ActiveDocument.FormFields("B12Answer").Result = "D"
End If
'Question 13
If ActiveDocument.FormFields("BC13").CheckBox.Value <> True Then
ActiveDocument.FormFields("B13Answer").Result = "B"
End If
'Question 14
If ActiveDocument.FormFields("BB14").CheckBox.Value <> True Then
ActiveDocument.FormFields("B14Answer").Result = "C"
End If
'Question 15
If ActiveDocument.FormFields("BD15").CheckBox.Value <> True Then
ActiveDocument.FormFields("B15Answer").Result = "C"
End If
'Question 16
If ActiveDocument.FormFields("BC16").CheckBox.Value <> True Then
ActiveDocument.FormFields("B16Answer").Result = "D"
End If
'Question 17
If ActiveDocument.FormFields("BD17").CheckBox.Value <> True Then
ActiveDocument.FormFields("B17Answer").Result = "A"
End If
'Question 18
If ActiveDocument.FormFields("BA18").CheckBox.Value <> True Then
ActiveDocument.FormFields("B18Answer").Result = "B"
End If
'Question 19
If ActiveDocument.FormFields("BA19").CheckBox.Value <> True Then
ActiveDocument.FormFields("B19Answer").Result = "B"
End If
'Question 20
If ActiveDocument.FormFields("BD20").CheckBox.Value <> True Then
ActiveDocument.FormFields("B20Answer").Result = "D"
End If
'Question 21
If ActiveDocument.FormFields("BD21").CheckBox.Value <> True Then
ActiveDocument.FormFields("B21Answer").Result = "A"
End If
'Question 22
If ActiveDocument.FormFields("BD22").CheckBox.Value <> True Then
ActiveDocument.FormFields("B22Answer").Result = "B"
End If
'Question 23
If ActiveDocument.FormFields("BD23").CheckBox.Value <> True Then
ActiveDocument.FormFields("B23Answer").Result = "C"
End If
'Question 24
If ActiveDocument.FormFields("BD24").CheckBox.Value <> True Then
ActiveDocument.FormFields("B24Answer").Result = "D"
End If
'Question 25
If ActiveDocument.FormFields("BD25").CheckBox.Value <> True Then
ActiveDocument.FormFields("B25Answer").Result = "B"
End If
End If

If RunningCheckBoxSum = 25 Then
ActiveDocument.FormFields("Message2").Result = "CONGRATULATIONS!!!
Perfect Score!"
End If

If RunningCheckBoxSum >= 20 And RunningCheckBoxSum < 25 Then
ActiveDocument.FormFields("Message2").Result = "Very Good. You
passed. Your score was " & (RunningCheckBoxSum * 5) & "%."
End If

If RunningCheckBoxSum < 20 Then
ActiveDocument.FormFields("Message2").Result = "Sorry, you did not
pass. Your score was below 80. Please re-read the material and try again."
End If
ActiveDocument.FormFields("Message1").Result = ""

End Sub

Function GetValueFromName(FormFieldName As Variant)
Dim ValueStartPos As Integer
Dim FormFieldValue As Integer
If InStr(FormFieldName, "Val") Then
ValueStartPos = InStr(FormFieldName, "Val") + 3
FormFieldValue = Mid(FormFieldName, ValueStartPos)
End If
GetValueFromName = FormFieldValue
End Function


Public Sub OneAnswerCheck()

Dim FFNmSect As String
Dim FFNmCol As String
Dim FFNmQuest As String
Dim VarNm As String
Dim aVar As Variable

CurFFNm = Selection.FormFields(1).Name
FFNmSect = Mid(CurFFNm, 1, 1)
FFNmCol = Mid(CurFFNm, 2, 1)
FFNmQuest = Mid(CurFFNm, 3)
VarNm = Mid(CurFFNm, 1, 1) & Mid(CurFFNm, 3)

LastChoiceCol = ActiveDocument.Variables(VarNm).Value

ActiveDocument.FormFields(FFNmSect & LastChoiceCol &
FFNmQuest).CheckBox.Value = False
ActiveDocument.Variables(VarNm).Value = FFNmCol
End Sub

Public Sub LdOneAnswerCheck()

Dim CurFFNm As String
Dim VarName As String
CurFFNm = Selection.FormFields(1).Name
VarName = Mid(CurFFNm, 1, 1) & Mid(CurFFNm, 3)

If ActiveDocument.Variables(VarName).Value <> "0" Then
OneAnswerCheck
Else
ActiveDocument.Variables(VarName).Value = Mid(CurFFNm, 2, 1)
End If
End Sub

Public Sub InitForm()
' To deselect all checkboxes from last use and initialize all variables to
zero. The
' variables keep track of which checkbox has already been selected. One
variable per
' row. The row variable will hold the value of the column of the selected
checkbox
' or it will equal "0" to indicate no checkboxes are selected for that row.
Each
' row represents a question name, such as "A2" (second question A section)
or "B3"
' (third question B section). This information comes from the checkbox
names, which
' you get from doubleclicking on them.

Dim ffldsChkBoxes As Word.FormFields
Dim frmField As Word.FormField
Dim CurFFNm As String

' If Variables which hold col of selected checkbox do not exist, add them
If ActiveDocument.Variables.Count < 30 Then


ActiveDocument.Variables.Add Name:="B9", Value:="0"
ActiveDocument.Variables.Add Name:="B10", Value:="0"
ActiveDocument.Variables.Add Name:="B11", Value:="0"
ActiveDocument.Variables.Add Name:="B12", Value:="0"
ActiveDocument.Variables.Add Name:="B13", Value:="0"
ActiveDocument.Variables.Add Name:="B14", Value:="0"
ActiveDocument.Variables.Add Name:="B15", Value:="0"
ActiveDocument.Variables.Add Name:="B16", Value:="0"
ActiveDocument.Variables.Add Name:="B17", Value:="0"
ActiveDocument.Variables.Add Name:="B18", Value:="0"
ActiveDocument.Variables.Add Name:="B19", Value:="0"
ActiveDocument.Variables.Add Name:="B20", Value:="0"
ActiveDocument.Variables.Add Name:="B21", Value:="0"
ActiveDocument.Variables.Add Name:="B22", Value:="0"
ActiveDocument.Variables.Add Name:="B23", Value:="0"
ActiveDocument.Variables.Add Name:="B24", Value:="0"
ActiveDocument.Variables.Add Name:="B25", Value:="0"

Else
For Each aVar In ActiveDocument.Variables
aVar.Value = "0"
Next aVar
End If

' If Variables which hold col of selected checkbox do exist, initialize them
to zero

' Deselect all checkboxes
Set ffldsChkBoxes = ActiveDocument.FormFields
For Each frmField In ffldsChkBoxes
If frmField.Type = wdFieldFormCheckBox Then
If frmField.CheckBox.Value = True Then
frmField.CheckBox.Value = False
End If
Else
If frmField.Type = wdFieldFormTextInput Then
'frmField.TextInput.Clear
frmField.Result = ""
End If
End If
Next
End Sub

Private Sub Command1_Click()
label1 = "Please wait..."
'label1.Refresh
'Call BigFunction
label1 = vbNullString
End Sub
 
D

Doug Robbins - Word MVP

Did you assign the expected bookmark names to the formfields that you added?

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
D

Doug Robbins - Word MVP

The easiest way to sort this out might be if you were to send me a copy of
the form.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 
D

dsc2bjn

I can do that, but will need an email addy. I haven't found a way to upload
a copy of the form to this discussion group.
 
D

Doug Robbins - Word MVP

If you look at my message when you are replying, you will see
<[email protected]> Delete the upper case letters.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top