View Single Post
 
Old 02-23-2021, 04:25 PM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,977
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

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.
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote