View Single Post
 
Old 04-22-2012, 02:55 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,962
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi Cathy,

Your document will need some vba code to do what you want. Try adding the following code to your document's 'ThisDocument' module:
Code:
Option Explicit
Dim oTbl As Table, oCel As Cell
Dim lRow As Long, lCol As Long, lColIdx As Long
Dim lRowCount As Long, lCtlCount As Long
 
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
With Selection
  If .Information(wdWithInTable) Then
    Set oTbl = .Tables(1)
    lCol = .Cells(1).ColumnIndex
    lRow = .Cells(1).RowIndex
  End If
End With
End Sub
 
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If oTbl = Nothing Then Exit Sub
With oTbl
  If ContentControl.Type = wdContentControlCheckBox Then
    If ContentControl.Checked = True Then
      For Each oCel In .Rows(lRow).Cells
        With oCel.Range
          If .ContentControls.Count > 0 Then
            If .ContentControls(1).Type = wdContentControlCheckBox Then
              If oCel.ColumnIndex <> lCol Then
                If .ContentControls(1).Checked = True Then lColIdx = oCel.ColumnIndex
                .ContentControls(1).Checked = False
              End If
            End If
          End If
        End With
      Next
    End If
  End If
  Call Tally
End With
Set oTbl = Nothing
End Sub
 
Private Sub Tally()
Application.ScreenUpdating = False
With oTbl
  For Each oCel In .Columns(lCol).Cells
    With oCel.Range
      If .ContentControls.Count > 0 Then
        If .ContentControls(1).Type = wdContentControlCheckBox Then
          lRowCount = lRowCount + 1
          If .ContentControls(1).Checked = True Then lCtlCount = lCtlCount + 1
        End If
      End If
    End With
  Next
  With .Columns(lCol)
    If lRowCount > 0 Then .Cells(.Cells.Count).Range.Text = (lCtlCount / lRowCount) * .Index
  End With
  lRowCount = 0: lCtlCount = 0
  If lColIdx > 0 Then
    For Each oCel In oTbl.Columns(lColIdx).Cells
      With oCel.Range
        If .ContentControls.Count > 0 Then
          If .ContentControls(1).Type = wdContentControlCheckBox Then
            lRowCount = lRowCount + 1
            If .ContentControls(1).Checked = True Then lCtlCount = lCtlCount + 1
          End If
        End If
      End With
    Next
    With .Columns(lColIdx)
      .Cells(.Cells.Count).Range.Text = (lCtlCount / lRowCount) * .Index
    End With
  End If
  lRowCount = 0: lCtlCount = 0: lColIdx = 0: lCol = 0: lRow = 0
End With
Application.ScreenUpdating = True
End Sub
To see how to install the macros, go to: http://www.gmayor.com/installing_macro.htm
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]

Last edited by macropod; 04-22-2012 at 03:12 PM. Reason: Simplified code
Reply With Quote