Epikurosz Creative Commons License 2008.08.18 0 0 4
Így néz ki a VB kód:
--------------------------
Option Explicit
Public gintTotal As Integer
Public gintTestTaken As Integer
Private Sub Eredmény_Click()

'checks to see if GLOBAL variable "flag"
'has been set to see if user has already
'entered a final score, so the score can't be changed
'otherwise, if var is not set, then proceeds with calc

If gintTestTaken = 1 Then
MsgBox "Sorry, you have already calculated your score!"
Else
'calls separate routine to add up totals
'you can position your cursor inside name
'and hit Shift/F2 to jump to that procedure
'to read that code to see what happens next

Call CalcScores

'declares variables for this procedure
Dim strComments As String
Dim bkRange As Range

'quickly calls another routine to unlock form
'note that you can use the "Call" command or not
'it doesn't matter, except for how you would enter
'variables, if we were passing them. When using Call,
'any passed vars need to go in parens. That's info only
'as we're not doing there here!
ToggleFormLock

'sets bookmarked location to total score
ActiveDocument.Bookmarks("TotalScore").Range.Text = gintTotal

'relocks form
ToggleFormLock

'sets the GLOBAL variable flag to 1
'to show the score cannot be changed!
gintTestTaken = 1

'create message for scores
'this is optional and you'll need to change the
'settings for the total score. Since I only have three
'questions. If you have more, adjust these numbers or
'you can comment this code out by putting an apostrophe
'in front of each line, or just rip it out!
If gintTotal < 50 Then
strComments = "Elégtelen! / Non-satisfactory."
ElseIf gintTotal > 50 And gintTotal < 60 Then
strComments = "Megfelelt. / Acceptable."
ElseIf gintTotal > 60 And gintTotal < 70 Then
strComments = "Jó! / Good!"
ElseIf gintTotal > 70 And gintTotal < 80 Then
strComments = "Nagyon jó! / Very good!"
ElseIf gintTotal > 80 Then
strComments = "Magnum cum laudae!!!"
End If
'concatenate your message with the results
'note! If you rip out the message above, also change this code!
MsgBox "Az eredmény / Your Total Score: " & gintTotal & ", vagyis /i.e.: " & strComments
End If
End Sub

Private Sub Document_New()
'sets both global variables
'...for total and score fields...
'to zero so they can run at least once
gintTotal = 0
gintTestTaken = 0
End Sub

Sub ExclusiveCheckboxes()
'declare an object as the form field
Dim objField As FormField
'for each checkbox (form field) in this current frame set
'(or range of form fields), set all the values to false
'and loop through to make sure they are all set to false (unchecked)
For Each objField In Selection.Frames(1).Range.FormFields
objField.CheckBox.Value = False
Next objField
'now set the currently selected checkbox value to true
Selection.FormFields(1).CheckBox.Value = True
End Sub

Sub CalcScores()
Dim objAllChecks As FormField
Dim strName As String
'this loops through all the document fields, and if they
'are checkboxes, it captures the bookmark name of the
'checkbox and puts it into a string to check it to see if
'it is a correct answer
For Each objAllChecks In ActiveDocument.FormFields
objAllChecks.Select
If objAllChecks.Type = wdFieldFormCheckBox Then
strName = objAllChecks.Name
'DEBUG
'az alábbi üzenettel
'csak annyit lehet ellenőrizni, hogy
'a helyes jelölőnégyzeten vagyok-e éppen
' MsgBox strName
'you will need to modify the code below to one CASE for every
'CORRECT answer. If the correct answer is checked to true,
'then the GLOBAL variable holding the score will have 1 added
'to it.
Select Case strName
Case "Q1_c"
If Selection.FormFields(strName).CheckBox.Value = True Then
gintTotal = gintTotal + 1
End If
Case "Q2_b"
If Selection.FormFields(strName).CheckBox.Value = True Then
gintTotal = gintTotal + 1
End If
Case "Q3_c"
If Selection.FormFields(strName).CheckBox.Value = True Then
gintTotal = gintTotal + 1
End If
Case "Q4_b"
.....................
Case "Q151_c"
If Selection.FormFields(strName).CheckBox.Value = True Then
gintTotal = gintTotal + 1
End If
'Case Else
'DEBUG
'this is also a debugging tool. When you are testing
'your code, you should make sure the message box below
'is uncommented to catch any fields that contain typos.
'if they are not found, it means they don't match the
'actual field name. A typo could cause an incorrect score!
'You should only see this for incorrect checkboxes. When
'run in conjunction with the name message above, you can
'see the field name and see if it's found or not
'if a CORRECT answer is not found, you messed up!
MsgBox "This incorrect answer was not found"
End Select
End If
Next objAllChecks
End Sub

Sub ToggleFormLock()
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
ActiveDocument.Unprotect
'if a password is used, add the line below after a space above
'Password:="myPassword"
Else
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
'if a password is used, add a comma after
'the last line and include the line below
'Password:="myPassword"
End If
End Sub
------------------------------------

A kódot eredetileg a neten találtam, és adaptáltam a projektemhez.
Előzmény: Epikurosz (3)