Microsoft Office Forums - View Single Post - Add numbers associated with a Style to obtain a total

Guessed · 10-31-2022, 10:11 PM

I think this is requires VBA and I would do it with Content Controls so you can store sectional scores and possible marks and total both at the top of the document.

I've created a demonstration of this method with some Content Controls for each area where you want to assign a score. I've used the Title and Tag settings to allow the macro to make the decisions.

The code is in the ThisDocument module.

Code:

Private Sub Document_ContentControlOnExit(ByVal aCC As ContentControl, Cancel As Boolean)
  Dim iTally As Double, iScore As Double, iMax As Double, iResp As Integer, aCCsect As ContentControl
  Dim arrMark() As String, iMark As Double
  Select Case aCC.Title
    Case "Overall Mark"
      If aCC.ShowingPlaceholderText Or aCC.Range.Text Like "0*" Then
        iResp = MsgBox("Do you want to reset/clear all marks from this document?", vbYesNo + vbCritical, "Clear All")
        If iResp = vbYes Then
          For Each aCCsect In ActiveDocument.SelectContentControlsByTitle("Section Mark")
            iMax = iMax + aCCsect.Tag
            aCCsect.Range.Text = ""
          Next aCCsect
          aCC.SetPlaceholderText Text:="Test is marked out of " & iMax
        End If
      End If
    Case "Section Mark"
      aCC.SetPlaceholderText Text:="This section is worth " & aCC.Tag
      For Each aCCsect In ActiveDocument.SelectContentControlsByTitle("Section Mark")
        iMax = iMax + aCCsect.Tag
        If Not aCCsect.ShowingPlaceholderText Then
          arrMark = Split(aCCsect.Range.Text, " / ")
          iMark = arrMark(0)
          aCCsect.Range.Text = iMark & " / " & aCCsect.Tag
          iScore = iScore + iMark
        End If
      Next aCCsect
      With ActiveDocument.SelectContentControlsByTitle("Overall Mark")(1)
        .LockContents = False
        If iScore > 0 Then
          .Range.Text = iScore & " / " & iMax
        Else
          .Range.Text = ""    'show placeholder text
        End If
        .LockContents = True
      End With
  End Select
End Sub