![]() |
#9
|
||||
|
||||
![]()
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
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
mrlemmer11 | Word VBA | 1 | 07-05-2015 03:23 PM |
How to Hide/Un-hide a worksheet based on cell on another sheet. | easton11 | Excel Programming | 1 | 06-02-2015 12:07 PM |
Inserts a checkmark when click on a cell | imfloyd | Excel | 3 | 01-17-2015 04:52 AM |
Hide cursor in Word file | Cosmo | Word | 1 | 10-26-2012 02:46 PM |
Checkmark function problem | todddesignr | PowerPoint | 0 | 07-29-2011 07:40 AM |