Bug w/Word Content Controls??

[gmaxey]

I think I have found a bug when trying to add a row to a table that contains content controls what are locked from being deleted.

Create a word table with a couple of rows. Add CC to each row and set the CC property "Can not be deleted" to true.

Put your cursor in the first or second row and run:

Sub AddRowWithContent()
Dim oRow As Row
Dim oCC As ContentControl
Application.ScreenUpdating = False
If Selection.Information(wdWithInTable) Then
On Error GoTo Err_Handler
Set oRow = Selection.Tables(1).Rows.Add(BeforeRow:=Selection.Rows(1).Next)
End If
Application.ScreenUpdating = False
Exit Sub
Err_Handler:
If Err.Number = 4198 Then
Set oRow = Selection.Rows(1).Next
For Each oCC In oRow.Range.ContentControls
oCC.LockContentControl = False

Next oCC
Resume
End If
End Sub


I don't see why the error should occur but always does if the CC in the next row is locked.

[macropod]

Hi Greg,

Yes, that does seem to be a bug. Here's a workaround:
Sub AddRowWithContent()
Application.ScreenUpdating = False
Dim iRow As Long
With Selection
If .Information(wdWithInTable) Then
iRow = .Rows(1).Index
With .Tables(1)
If .Rows.Count > iRow Then
iRow = iRow + 1
.Split iRow
.Rows.Add
.Range.Characters.Last.Next.Delete
Else
.Rows.Add
iRow = iRow + 1
End If
With .Rows(iRow)
'add whatever processing you need for the new row here
End With
End With
End If
End With
Application.ScreenUpdating = False
End Sub

[gmaxey]

Paul,

Thanks. The code I posted was a stripped down version of what I am actually doing. The title AddRowWithContent may have been misleading.

I like your general process better than my so I'll use it. Thanks. Unfortunately the bug seems to extend to a copy paste process. Here is my revised code. Take out the CC unlock lines and you will see what I mean:

Sub AddRowWithContent()
Dim iRow As Long
Dim oRNg As Word.Range
Dim oCC As ContentControl
Application.ScreenUpdating = False
With Selection
If .Range.InRange(ActiveDocument.Bookmarks("bmDynamicTable").Range) Then
If .Type = wdSelectionIP Then
If Not .Rows(1).Cells(2).Range.ContentControls(1).ShowingPlaceholderText Then
If .Rows(1).Cells(2).Range.ContentControls(1).DropdownListEntries.Count > 2 Then
iRow = .Rows(1).Index
Set oRNg = .Tables(1).Rows(iRow).Range
'Clip end of cell mark.
oRNg.MoveEnd wdCharacter, -1
'Unlock any content controls. Otherwise an RTE occurs in the copy paste process.
For Each oCC In oRNg.ContentControls
oCC.LockContentControl = False
Next oCC
oRNg.Copy
With .Tables(1)
If .Rows.Count > iRow Then
iRow = iRow + 1
.Split iRow
.Rows.Add
.Range.Characters.Last.Next.Delete
Else
.Rows.Add
iRow = iRow + 1
End If
With .Rows(iRow).Range
.Paste
For Each oCC In .ContentControls
oCC.LockContentControl = True
Next oCC
End With
End With
For Each oCC In oRNg.ContentControls
oCC.LockContentControl = True
Next oCC
Else
MsgBox "This is a single role application. You cannot add a new role request for this application."
End If
Else
MsgBox "A selection has not been selected for this application role. Please select a role for before attempting to add a new role request."
End If
End If
Else
MsgBox "This procedure is available for adding additional application role requests only." & vbCr + vbCr _
& "The cursor must be located in a qualified row in the applications table."
End If
End With
Application.ScreenUpdating = False
End Sub

The purpose of this code is part of a larger project to make a table of applications, roles, and approvers be dynamic. The table list several dozen applications. Adjacent to each application is a dropdown CC that lists one or multiple roles. The initial table list each application only once. So if a user needs to request several roles for one applicaiton, I want them to be able to add a new row that duplicates the CC in the original row. The can then use the new CC to select the second role and so on.

It was all working quite nicely until I went to lock the CCs. Working nicely again. Thanks.

[macropod]

Hi Greg,

I don't have time to delve into this right now, but I recall working on an 'add row' function for CCs recently in another forum. FWIW, attached is a copy of the document I produced for that. With the approach taken I didn't encounter any issues regarding locked CCs so, naturally, it didn't occur to me that there might be an issue with an approach like yours. Of course, I was only adding to the last row in the table. However, if you combine that with the 'divide and conquer' approach from my previous post, you could add a new row anywhere in the table.

[gmaxey]

Paul,

No problem. I've made it work. Still even with apting the method in your attached document, if you copy a locked CC to the a new row the new CC is not locked unless you explicitly lock it. The whole thing just seems odd. Here is my adapted code for the specific application:

Sub AddRowWithContent()
Dim iRow As Long
Dim oRNg As Word.Range
Dim oCC As ContentControl
Dim bLocked As Boolean
Application.ScreenUpdating = False
With Selection
If .Range.InRange(ActiveDocument.Bookmarks("bmDynamicTable").Range) Then
If .Type = wdSelectionIP Then
If Not .Rows(1).Cells(2).Range.ContentControls(1).ShowingPlaceholderText Then
If .Rows(1).Cells(2).Range.ContentControls(1).DropdownListEntries.Count > 2 Then
bLocked = .Rows(1).Cells(2).Range.ContentControls(1).LockContentControl
iRow = .Rows(1).Index
With .Tables(1)
If .Rows.Count > iRow Then
'Copy and paste content in new "inserted" row.
iRow = iRow + 1
'Split the table.
.Split iRow
'Copy content.
.Rows.Last.Range.Copy
'Paste content. Note: This kills the paragraph mark splitting the tables.
.Rows.Last.Range.Next.Paste
Else
'Copy and paste row content in new appended row.
.Rows.Last.Range.Copy
'Append new row.
.Rows.Add
Set oRNg = .Rows.Last.Range
'Clip end of row mark.
oRNg.MoveEnd wdCharacter, -1
'Paste content.
oRNg.Paste
iRow = iRow + 1
End If
'Work with new row content.
With .Rows(iRow)
'Clear the copied user entered content.
.Cells(1).Range.Text = ""
.Cells(3).Range.Text = ""
.Cells(4).Range.Text = ""
Set oCC = .Cells(2).Range.ContentControls(1)
With oCC
If bLocked Then
.LockContentControl = True
End If
.DropdownListEntries.Item(1).Select
'Setup for user to make selection.
.Range.Select
End With
Set oCC = Nothing
End With
End With
Else
MsgBox "This is a single role application. You cannot add a new role request for this application.", vbInformation + vbOKOnly, "INVALID ACTION"
End If
Else
MsgBox "A role has not been selected for this application role request line." & vbCr + vbCr _
& "Please select a role in this request line before attempting to add a new role request.", vbInformation + vbOKOnly, "INVALID ACTION"
End If
End If
Else
MsgBox "This procedure is available for adding additional application role requests only." & vbCr + vbCr _
& "The cursor must be located in a qualified row in the applications table.", vbInformation + vbOKOnly, "INVALID ACTION"
End If
End With
Application.ScreenUpdating = False
End Sub



Hi Greg,

I don't have time to delve into this right now, but I recall working on an 'add row' function for CCs recently in another forum. FWIW, attached is a copy of the document I produced for that. With the approach taken I didn't encounter any issues regarding locked CCs so, naturally, it didn't occur to me that there might be an issue with an approach like yours. Of course, I was only adding to the last row in the table. However, if you combine that with the 'divide and conquer' approach from my previous post, you could add a new row anywhere in the table.

[gmaxey]

Paul,

I had a couple of other problems with your code (could have been my fault). It seems that if the document was not protected then running the code would turn on track changes. I've also adapted it some so that a user and insert a new row in an existing table or append when exiting the last cell:

Option Explicit
Dim bLastCell As Boolean
Dim oTargetRow As Word.Row
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
With Selection.Range
If .Information(wdWithInTable) Then
If .Cells(1).RowIndex = .Tables(1).Range.Cells(.Tables(1).Range.Cells.Count).RowIndex Then
If .Cells(1).ColumnIndex = .Tables(1).Range.Cells(.Tables(1).Range.Cells.Count).ColumnIndex Then
bLastCell = True
Set oTargetRow = Selection.Rows(1)
End If
End If
End If
End With
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If bLastCell = True Then
If MsgBox("Add new row?", vbQuestion + vbYesNo) = vbYes Then
InsertRowWithContent
End If
bLastCell = False
Else
Set oTargetRow = Nothing
End If
End Sub
Sub InsertRowWithContent()
Dim vProtectionType As Variant, strPassword As String
Dim iRow As Long
Dim oRNg As Word.Range
Dim oCC_Master As ContentControl, oCC_Clone As ContentControl
vProtectionType = ActiveDocument.ProtectionType
Select Case True
Case Not oTargetRow Is Nothing, Selection.Information(wdWithInTable)
Application.ScreenUpdating = False
If vProtectionType <> wdNoProtection Then
strPassword = "" 'Insert password here
ActiveDocument.Unprotect Password:=strPassword
End If
With Selection
If oTargetRow Is Nothing Then
Set oTargetRow = Selection.Rows(1)
End If
Debug.Print oTargetRow.Index
iRow = oTargetRow.Index '.Rows(1).Index
With .Tables(1)
If .Rows.Count > iRow Then
'Copy and paste content in new "inserted" row.
iRow = iRow + 1
'Split the table.
.Split iRow
'Copy content.
.Rows.Last.Range.Copy
'Paste content. Note: This kills the paragraph mark splitting the tables.
.Rows.Last.Range.Next.Paste
Else
'Copy and paste row content in new appended row.
.Rows.Last.Range.Copy
'Append new row.
.Rows.Add
Set oRNg = .Rows.Last.Range
'Clip end of row mark.
oRNg.MoveEnd wdCharacter, -1
'Paste content.
oRNg.Paste
iRow = iRow + 1
End If
'Work with new row content.
With .Rows(iRow)
Dim i As Long
For i = 1 To .Previous.Range.ContentControls.Count
Set oCC_Master = .Previous.Range.ContentControls(i)
Set oCC_Clone = .Range.ContentControls(i)
With oCC_Clone
If .Type = 8 Then .Checked = False 'Used 8 so this procedure will compile in Word 2007
If .Type = wdContentControlRichText Or .Type = wdContentControlText Or .Type = wdContentControlDate Then .Range.Text = ""
If .Type = wdContentControlDropdownList Or .Type = wdContentControlComboBox Then .DropdownListEntries(1).Select
If .Type = wdContentControlPicture Then
If .Range.InlineShapes.Count > 0 Then .Range.InlineShapes(1).Delete
End If
.LockContentControl = oCC_Master.LockContentControl
End With
Next i
End With
End With
End With
If vProtectionType > -1 Then
ActiveDocument.Protect Type:=vProtectionType, Password:=strPassword
End If
Application.ScreenUpdating = False
Set oTargetRow = Nothing
Case Else
MsgBox "Put the cursor in the table you want to insert or append rows and try again.", vbInformation + vbOKOnly, "INVALID SELECTION"
End Select
End Sub


I was trying to finishing up when my wife called me for the tenth time to get ready to go out. There may be a issue or two that I will need to resolve in the posted code.

[gmaxey]

The bugs is also present when you try to use Table Tools>Row & Columns>Insert Above or Insert Below.

[gmaxey]

Paul,

Studying the AddRowWithContent macro, I discovered a few more issues that I wanted to address and share with you. You may have already noticed that I added a picture control to the mix. I discovered this morning that resizing the control to match the size in the copied row was a little trickier than I first thought.

I had also replaced wdContentControlCheckbox with 8 hoping it would compile in Word 2007. Well while 8 will ".Checked" won't. I had to create a psuedo CC using the Object variable.

My personal preference would be promted to add the new row when I entered the last row/last cell vice OnExit. If for no other reason than there may not be an exit point to exit to.

Option Explicit
Dim oTargetRow As Word.Row
Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
With Selection.Range
If .Information(wdWithInTable) Then
If .Cells(1).RowIndex = .Tables(1).Range.Cells(.Tables(1).Range.Cells.Count).RowIndex Then
If .Cells(1).ColumnIndex = .Tables(1).Range.Cells(.Tables(1).Range.Cells.Count).ColumnIndex Then
If MsgBox("This is the last row/last cell. Do you want to add a new new row?", vbQuestion + vbYesNo, "New Row") = vbYes Then
InsertRowWithContent
End If
Set oTargetRow = Selection.Rows(1)
End If
End If
End If
End With
End Sub
Sub InsertRowWithContent()
Dim vProtectionType As Variant, strPassword As String
Dim oRow As Word.Row
Dim iRow As Long
Dim oRNg As Word.Range
Dim oCC_Master As ContentControl, oCC_Clone As ContentControl, oCC_Psuedo As Object
vProtectionType = ActiveDocument.ProtectionType
On Error Resume Next
Set oRow = oTargetRow
If Error <> 0 Then
If Selection.Information(wdWithInTable) Then
If Selection.Rows(1).Range.ContentControls.Count > 0 Then
Set oRow = Selection.Rows(1)
End If
End If
End If
If Not oRow Is Nothing Then
Application.ScreenUpdating = False
If vProtectionType <> wdNoProtection Then
strPassword = "" 'Insert password here
ActiveDocument.Unprotect Password:=strPassword
End If
With Selection
iRow = oRow.Index
With .Tables(1)
If .Rows.Count > iRow Then
'Copy and paste content in new "inserted" row.
iRow = iRow + 1
'Split the table.
.Split iRow
'Copy content.
.Rows.Last.Range.Copy
'Paste content. Note: This kills the paragraph mark splitting the tables.
.Rows.Last.Range.Next.Paste
Else
'Copy and paste row content in new appended row.
.Rows.Last.Range.Copy
'Append new row.
.Rows.Add
Set oRNg = .Rows.Last.Range
'Clip end of row mark.
oRNg.MoveEnd wdCharacter, -1
'Paste content.
oRNg.Paste
iRow = iRow + 1
End If
'Work with new row content.
With .Rows(iRow)
Dim i As Long
For i = 1 To .Previous.Range.ContentControls.Count
Set oCC_Master = .Previous.Range.ContentControls(i)
Set oCC_Clone = .Range.ContentControls(i)
With oCC_Clone
If .Type = 8 Then
Set oCC_Psuedo = oCC_Clone
oCC_Psuedo.Checked = False 'Used 8 and an object so this procedure will compile in Word 2007
End If
If .Type = wdContentControlRichText Or .Type = wdContentControlText Or .Type = wdContentControlDate Then .Range.Text = ""
If .Type = wdContentControlDropdownList Or .Type = wdContentControlComboBox Then .DropdownListEntries(1).Select
If .Type = wdContentControlPicture Then
If .Range.InlineShapes.Count > 0 Then .Range.InlineShapes(1).Delete
.Range.InlineShapes(1).Select
Selection.InlineShapes(1).Width = oCC_Master.Range.InlineShapes(1).Width
End If
.LockContentControl = oCC_Master.LockContentControl
End With
Next i
End With
End With
End With
If vProtectionType > -1 Then
ActiveDocument.Protect Type:=vProtectionType, Password:=strPassword
End If
Application.ScreenUpdating = False
Set oTargetRow = Nothing
Else
MsgBox "The cursor must be locate in a table row containing content controls.", vbInformation + vbOKOnly, "INVALID SELECTION"
End If
End Sub

[fumei]

Darn, I wish I could see that file... I dumped 2010, and the viewer I have does not open docM.

[gmaxey]

Gerry,

Why would you dump Word 2010? ;-)

What can I do? If pictures will help, I published a tips page:
http://gregmaxey.mvps.org/word_tip_pages/add_table_row_with_content.html

[fumei]

"Why would you dump Word 2010? ;-)"

Hopefully that is a rhetorical question...

[macropod]

Hi Greg,

I'm beginning to think that the whole process might be made simpler by storing the 'locked' status (eg as a comma-delimited string of the cell indices) of each CC on the row below which the new row is to be added, unlocking all CCs on that row, inserting the new row (without splitting the table), then re-locking the cells on both rows per the stored string. The same approach could be extended to the addition of new columns.

As for CC checkboxes, you can test the Word version before testing for the checkbox status:
If Int(Application.Version) >= 14 Then
If .Type = wdContentControlCheckBox Then
.Checked = False
End If
End If

[gmaxey]

Hi Paul,

Working with the column is a "whole" lot more complicated than working with the row. With the column, it appears that if there is a locked CC anywhere in the table then the insert column UI and .Column.Add is broken :-). Add that to the fact that since a column doesn't have a range (or if it does I don't know how to access it) I had to loop through each cell in each column.

The wdContentControlChecked adn .Checked will still throw an error unless the code you suggested is wrapped in conditional tags:

Here is some some code to insert a column to the right of a column in the table with the selection. It accomodates a single merged title row. I may have made this much harder than it needs to be as I may have lost sight of the forrest for the trees. One thing I can't figure out and can use some help with is how to add a column and the colleciton of columns (original + new) stay withing the existing "width" of the overal table. I cobbled together a fix, but I don't really like it.

I'll go back later and modify the AddRow code with what I have learned here. I don't think this needs an automated querry to add column OnExit from the last CC.


Sub InsertColumnWithContent()
Dim vProtectionType As Variant, strPassword As String
Dim oTbl As Word.Table
Dim oRow As Word.Row
Dim oCol As Word.Column
Dim oCell As Word.Cell
Dim lngCol As Long
Dim oRng As Word.Range
Dim lngIndex As Long
Dim arrCCLocked() As String
Dim strLocked As String
Dim arrLocked() As String
Dim lngWidth As Long
Dim oSplitter As Word.Range
Dim bSplit As Boolean
Dim oCC As ContentControl
Dim lngCellIndex As Long, lngCCIndex As Long
bSplit = False
If Selection.Information(wdWithInTable) And Selection.InRange(Selection.Cells(1).Range) Then
'Selection must be in a table and not extend beyond bounds of a single cell.
vProtectionType = ActiveDocument.ProtectionType
If vProtectionType <> wdNoProtection Then
strPassword = "" 'Insert password here
ActiveDocument.Unprotect Password:=strPassword
End If
Application.ScreenUpdating = False
Set oTbl = Selection.Tables(1)
If Not oTbl.Uniform Then
'See if there is a heading row.
If oTbl.Columns.Count > 1 And oTbl.Rows(1).Range.Cells.Count = 1 Then
Set oRow = Selection.Rows(1)
'Split off the title row.
Set oRng = oTbl.Range
oRng.Start = oTbl.Rows(2).Range.Start
With oRng
.Tables(1).Split 2
Set oSplitter = oRng.Characters(1)
.MoveStart wdCharacter, 1
Set oTbl = oRng.Tables(1)
If oRow.Index = 1 Then
Set oCol = oTbl.Columns(1)
Else
Set oCol = Selection.Columns(1)
End If
bSplit = True
End With
End If
Else
Set oCol = Selection.Columns(1)
End If
If oTbl.Uniform Then
'Get and store lock property status of CCs in column to duplicate.
For Each oCell In oCol.Cells
For Each oCC In oCell.Range.ContentControls
strLocked = strLocked & oCC.LockContentControl & ","
Next oCC
Next oCell
If strLocked <> "" Then
strLocked = Left(strLocked, Len(strLocked) - 1)
arrLocked = Split(strLocked, ",")
End If
lngCol = oCol.Index
With oTbl
'Get and store lock status of all CCs in table. Unlock all CCs.
ReDim arrCCLocked(.Range.ContentControls.Count - 1, 1)
For lngIndex = 0 To .Range.ContentControls.Count - 1
arrCCLocked(lngIndex, 0) = .Range.ContentControls(lngIndex + 1).ID
arrCCLocked(lngIndex, 1) = .Range.ContentControls(lngIndex + 1).LockContentControl
.Range.ContentControls(arrCCLocked(lngIndex, 0)).LockContentControl = False
Next lngIndex
'Insert new column and duplicate content of current column.
lngWidth = oCol.Width 'Selection.Columns(1).Width
If .Columns.Count > lngCol Then
lngCol = lngCol + 1
.Columns.Add .Columns(lngCol)
oCol.Width = lngWidth / 2
.Columns(lngCol).Width = lngWidth / 2
Else
.Columns.Add
oCol.Width = lngWidth / 2
oCol.Next.Width = lngWidth / 2
End If
'Copy and paste each cell in current column to new cell in new column
For lngIndex = 1 To oCol.Cells.Count
oCol.Cells(lngIndex).Range.Copy
.Columns(lngCol).Cells(lngIndex).Range.Paste
Next lngIndex
'Apply stored locking property value to original CCs in table.
For lngIndex = 0 To UBound(arrCCLocked)
Set oCC = .Range.ContentControls(arrCCLocked(lngIndex, 0))
oCC.LockContentControl = arrCCLocked(lngIndex, 1)
Next lngIndex
'Reset content in CCs in the new inserted column. Set locking property to match CCs in original column.
lngIndex = 0
lngCellIndex = 1
For Each oCell In oCol.Next.Cells
lngCCIndex = 1
For Each oCC In oCell.Range.ContentControls
With oCC
#If VBA7 Then
If Int(Application.Version) >= 14 Then
If .Type = wdContentControlCheckBox Then
.Checked = False
End If
End If
#End If
If .Type = wdContentControlRichText Or _
.Type = wdContentControlText Or _
.Type = wdContentControlDate Then
If Not .ShowingPlaceholderText Then
.Range.Text = ""
End If
End If
If .Type = wdContentControlDropdownList Or .Type = wdContentControlComboBox Then
.DropdownListEntries(1).Select
End If
If .Type = wdContentControlPicture Then
If Not .ShowingPlaceholderText Then
If .Range.InlineShapes.Count > 0 Then
.Range.InlineShapes(1).Delete
.Range.InlineShapes(1).Width = oCol.Cells(lngCellIndex).Range.ContentControls(lngCCIndex).Range.InlineShap es(1).Width
End If
'.Range.InlineShapes(1).Select
'Selection.InlineShapes(1).Width = oCC.Range.InlineShapes(1).Width
End If
End If
.LockContentControl = arrLocked(lngIndex)
lngIndex = lngIndex + 1
End With
lngCCIndex = lngCCIndex + 1
Next oCC
lngCellIndex = lngCellIndex + 1
Next oCell
End With
If vProtectionType > -1 Then
ActiveDocument.Protect Type:=vProtectionType, Password:=strPassword
End If
Application.ScreenUpdating = True
If bSplit Then
oSplitter.Delete
End If
Else
MsgBox "The selected table has merged cells and cannot be processed." _
& vbInformation + vbOKOnly, "INVALID SELECTION"
End If
Else
MsgBox "The selection must be collapsed and the cursor located in a table cell" _
& " containing one or more content controls.", vbInformation + vbOKOnly, "INVALID SELECTION"
End If
lbl_Exit:
Exit Sub
End Sub

[gmaxey]

Paul (and others interested),

I'm attaching a document with the code for adding row or column with content. Feedback (+/-) always welcomed.

The add row executes automatically when the user enter the last cell last row.

There are two icons on the QAT for manually adding a row or column.