PDA

View Full Version : Word VBA to add a Row in a table



liono
07-14-2016, 01:32 AM
Good Morning

I am new to this site and am wanting some assistance in completing the code I am trying to put together. I have found various parts of the code in different places.

What I have is a Word (2016) form that is protected allowing the user to fill in the form. The form has 9 tables with various content controls.
I am wanting the vba to work only on the final table and to ask if the user wants to add another row. It currently asks in

The problems i am having:

When other check boxes are selected in the previous tables it runs through the rest of the check box controls to the end of the table and then asks if i would like another row.
When the form is unprotected it will copy the last row of table 9 but when the form is protected i get "runtime error 5991"


Please advise


VBA


Option Explicit
Dim bLastCell As Boolean


Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
With Selection.Range
If .Information(wdWithInTable) Then
'To limit processing to a particular table, change:
' Selection.Tables(1).Range below, to:
' ActiveDocument.Tables(#).Range, where # is the table index.
With ActiveDocument.Tables(9).Range
If Selection.Cells(1).RowIndex = .Cells(.Cells.Count).RowIndex Then
If Selection.Cells(1).ColumnIndex = .Cells(.Cells.Count).ColumnIndex Then
bLastCell = True
End If
End If
End With
End If
End With
End Sub


Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim CCtrl As ContentControl, Prot As Variant, Pwd As String
If bLastCell = True Then
If MsgBox("Add new row?", vbQuestion + vbYesNo) = vbYes Then
With ActiveDocument
Prot = .ProtectionType
If .ProtectionType <> wdNoProtection Then
Pwd = "" 'Insert password here
Prot = .ProtectionType
.Unprotect Password:=Pwd
End If
With Selection.Tables(1).Rows
With .Last.Range
.Copy
.Next.InsertBefore vbCr
.Next.Paste
End With
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
.Protect Type:=Prot, Password:=Pwd
End With
End If
bLastCell = False
End If
End Sub





Liono

gmaxey
07-19-2016, 03:39 PM
Private bLastCell As Boolean
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
Dim oTbl As Word.Table
bLastCell = False
With ActiveDocument.Tables(9)
If Selection.InRange(.Cell(.Rows.Count, .Columns.Count).Range) Then
bLastCell = True
End If
End With
End Sub

liono
07-19-2016, 11:50 PM
Thanks Greg, I have seen your workings while looking for a solution to this. I appreciate your help.

I have entered the solution you suggested and i get an error in this area of the code...

With Selection.Tables(1).Rows
With .Last.Range
.Copy
.Next.InsertBefore vbCr
.Next.Paste
End With


Please advise

Leon

gmaxey
07-20-2016, 04:05 AM
Lean,

The code your half and my half works fine here. I suppose I would have to see your document.

gmaxey
07-20-2016, 04:07 AM
You may also find the information here useful: http://gregmaxey.mvps.org/word_tip_pages/add_table_row_with_content.html

gmaxey
07-20-2016, 04:41 AM
It might be easier to just give the CC that you want to use as the trigger a unique tag (e.g., "Last")

Then you don't need the Enter event at all.


Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim oCC As ContentControl
If ContentControl.Tag = "Last" Then
With Selection.Tables(1).Rows.Last.Range
.Next.InsertBefore vbCr
.Next.FormattedText = .FormattedText
End With
ContentControl.Tag = ""
With Selection.Tables(1).Rows.Last.Range
For Each oCC In .ContentControls
With oCC
Select Case .Type
Case 8: .Checked = False
Case 0, 1, 6: .Range.Text = ""
Case 3, 4: .DropdownListEntries(1).Select
Case 2: .Range.InlineShapes(1).Delete
End Select
End With
Next oCC
End With
End If
lbl_Exit:
Exit Sub
End Sub

liono
07-20-2016, 05:25 AM
Having looked at many of the solutions and taken some advice, i decided to go with a button option to add a new row.
It seems like a better option and removed much of the complicated code.

I have attached for review and to help anyone else if needed.

Thanks for all your help.

Leon