I've had a play with this and think there are multiple ways to score a sheet. I'm going to ignore your /7 suggestion as I can't appreciate your logic for that number. Instead, I'll provide two possible methods of scoring. Method 1 is simplistic as it treats EVERY checkbox as an independent question and so a completely blank sheet will likely return a score well over 50%.
Method 2 requires you to add Rich Text CCs around each question/answer set so there is a scope for the macro to determine where a question starts and finishes. It then applies a hard binary score for that question - you have to have each checkbox correct to get 1 otherwise you get zero. I like this method 2 macro because it highlights exactly where the student made mistakes and what they 'should' have chosen.
Code:
Sub ScoreQuiz1()
Dim aCC As ContentControl, iColor As Long, iShowCC As Integer
Dim iChecks As Integer, iRight As Integer, bRight As Boolean
funShow True
For Each aCC In ActiveDocument.ContentControls
If aCC.Type = wdContentControlCheckBox Then
iChecks = iChecks + 1
bRight = aCC.Range.Paragraphs(1).Range.Font.ColorIndex = wdGreen
If aCC.Checked = bRight Then iRight = iRight + 1
End If
Next aCC
MsgBox "Correct answers: " & iRight & vbCr & "Out of: " & iChecks, vbInformation + vbOKOnly, "Paper Score Method 1"
End Sub
Sub ScoreQuiz2()
Dim aCC As ContentControl, aCCcb As ContentControl, aRng As Range
Dim iQuestions As Integer, iQ As Integer, iRight As Integer, bRight As Boolean
funShow True
For Each aCC In ActiveDocument.ContentControls
If aCC.Type = wdContentControlRichText Then aCC.Tag = "Question"
Next aCC
iQuestions = ActiveDocument.SelectContentControlsByTag("Question").Count
For Each aCC In ActiveDocument.SelectContentControlsByTag("Question")
Set aRng = aCC.Range
iQ = 1
For Each aCCcb In aRng.ContentControls
If aCCcb.Type = wdContentControlCheckBox Then
bRight = aCCcb.Range.Font.ColorIndex = wdGreen
If Not aCCcb.Checked = bRight Then
aCCcb.Range.Paragraphs(1).Range.ParagraphFormat.Shading.BackgroundPatternColorIndex = wdRed
iQ = 0
End If
End If
Next aCCcb
iRight = iRight + iQ
Next aCC
MsgBox "Correct answers: " & iRight & vbCr & "Out of: " & iQuestions, vbInformation + vbOKOnly, "Paper Score Method 2"
End Sub
Sub HideAnswers()
funShow False
End Sub
Sub ShowAnswers()
funShow True
End Sub
Sub funShow(bSet As Boolean)
Dim aCC As ContentControl, iColor As Long, iShowCC As Integer
If bSet Then
iColor = wdGreen
iShowCC = wdContentControlBoundingBox
Else
iColor = wdBlack
iShowCC = wdContentControlHidden
End If
ActiveDocument.Range.ParagraphFormat.Shading.BackgroundPatternColorIndex = wdWhite
For Each aCC In ActiveDocument.ContentControls
If aCC.Type = wdContentControlText Then
With aCC.Range.Paragraphs(1).Range.Font
.ColorIndex = iColor
.Bold = .ColorIndex = wdGreen
aCC.Appearance = iShowCC
End With
End If
Next aCC
End Sub
The macros should NOT be available to the students. This is easily done by putting the macros in the Attached Template (on your machine) instead of in the document itself. Save the student docs as docx. Since you have the macros, you can run them and the students won't know the macros exist.