Private Sub Document_ContentControlOnexit(ByVal aCC As ContentControl, Cancel As Boolean)
  Dim aCC2 As ContentControl, sTag As String, aTemplate As Template
  
  If aCC.Type = wdContentControlCheckBox Then
    sTag = aCC.Tag
    Set aTemplate = ActiveDocument.AttachedTemplate
    Set aCC2 = ActiveDocument.SelectContentControlsByTitle(sTag)(1)
    With aCC2
      If aCC.Checked Then
        aTemplate.BuildingBlockEntries("aa").Insert where:=aCC2.Range, RichText:=True
      Else
        aCC2.SetPlaceholderText Text:="Blank"
        aCC2.Range.Text = ""
      End If
    End With
  End If
End Sub