View Single Post
 
Old 06-18-2016, 08:56 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
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

There have been multiple threads discussing this issue, though all assume only a single table is subject to the addition of new rows. The following ContentControlOnExit macro allows you to nominate any set of tables you consider appropriate for the conditional addition of new rows. No command buttons are needed - the macro automatically prompts to add a new row when you exit the last content control in any of the nominated tables. As coded, this occurs in tables 1, 3, 5, & 6; you can change the series to any other set of tables.

Code:
Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
'The following code conditionally adds a new row, with content controls, to the designated table.
Dim i As Long, j As Long, Prot As Variant
Const Pwd As String = "" 'Insert password (if any) here
'Exit if we're not in a table.
If CCtrl.Range.Information(wdWithInTable) = False Then Exit Sub
With CCtrl
  'Check that the Content Control is within one of our designated tables.
  i = ActiveDocument.Range(0, .Range.End).Tables.Count
  Select Case i
    Case 1, 3, 5, 6 'The series of tables to process; other tables are excluded
      'Get the # of ContentControls in the table
      i = .Range.Tables(1).Range.ContentControls.Count
      'Get our ContentControl's index # in the table
      j = ActiveDocument.Range(.Range.Tables(1).Range.Start, .Range.End).ContentControls.Count
      'Check that we're using the last content control
      If i <> j Then Exit Sub
      'Solicit user input
      If MsgBox("Add new row?", vbQuestion + vbYesNo) <> vbYes Then Exit Sub
      With ActiveDocument
        ' Un-protect the document, if applicable
        Prot = .ProtectionType
        If .ProtectionType <> wdNoProtection Then
          Prot = .ProtectionType
          .Unprotect Password:=Pwd
        End If
        With Selection.Tables(1).Rows
          'Insert an empty paragraph after our table, then replace it with a replica of the last row
          With .Last.Range
            .Next.InsertBefore vbCr
            .Next.FormattedText = .FormattedText
          End With
          'Reset all content controls in the new last row
          For Each CCtrl In .Last.Range.ContentControls
            With CCtrl
              If .Type = wdContentControlCheckBox Then .Checked = False
              If .Type = wdContentControlRichText Or .Type = wdContentControlText Then .Range.Text = ""
              If .Type = wdContentControlDropdownList Then .DropdownListEntries(1).Select
              If .Type = wdContentControlComboBox Then .DropdownListEntries(1).Select
              If .Type = wdContentControlDate Then .Range.Text = ""
            End With
          Next
        End With
        ' Re-protect the document, if applicable
        .Protect Type:=Prot, Password:=Pwd
      End With
    Case Else
  End Select
End With
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote