Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
With CCtrl
  If .Type = wdContentControlCheckBox Then
    With ActiveDocument.SelectContentControlsByTitle(.Title & "Inits")(1)
      .LockContents = False
      .Range.Text = Application.UserInitials
      .LockContents = True
    End With
  End If
End With
Application.ScreenUpdating = True
End Sub