Unable to Add Content Control to Table Cell
Lee Polikoff
21
Reputation points
I am trying to add content controls to a table cell. When I try the following code in a new blank document it works fine. When I try it in a current document, sometimes it works and in others it throws a "Object Does Not Support This Action" error. What would prevent the creation of a content control in a table cell?
Sub Macro2()
'
' Macro2 Macro
'
'
Dim tblNew As Table
Set tblNew = ActiveDocument.Tables.Add(Selection.Range, 4, 7)
With tblNew
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
With tblNew
.Cell(Row:=1, Column:=1).Merge MergeTo:=.Cell(Row:=1, Column:=6)
.Cell(Row:=2, Column:=1).Merge MergeTo:=.Cell(Row:=2, Column:=6)
.Cell(Row:=3, Column:=1).Merge MergeTo:=.Cell(Row:=3, Column:=6)
.Cell(Row:=4, Column:=1).Merge MergeTo:=.Cell(Row:=4, Column:=7)
.Cell(1, 1).SetWidth ColumnWidth:=401.4, RulerStyle:=wdAdjustFirstColumn
.Cell(2, 1).SetWidth ColumnWidth:=401.4, RulerStyle:=wdAdjustFirstColumn
.Cell(3, 1).SetWidth ColumnWidth:=401.4, RulerStyle:=wdAdjustFirstColumn
.Cell(Row:=1, Column:=2).Merge MergeTo:=.Cell(Row:=3, Column:=2)
.Cell(1, 1).Shading.BackgroundPatternColor = RGB(198, 217, 241)
.Cell(2, 1).Shading.BackgroundPatternColor = RGB(198, 217, 241)
.Cell(3, 1).Shading.BackgroundPatternColor = RGB(198, 217, 241)
.Cell(4, 1).Shading.BackgroundPatternColor = RGB(198, 217, 241)
.Cell(1, 1).Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Cell(1, 1).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Cell(2, 1).Borders(wdBorderRight).LineStyle = wdLineStyleNone
.Cell(2, 1).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
.Cell(3, 1).Borders(wdBorderRight).LineStyle = wdLineStyleNone
End With
Dim rng As Word.Range
Set rng = tblNew.Cell(2, 1).Range
rng.Collapse wdCollapseStart
With rng.ContentControls.Add(wdContentControlRichText)
.Title = "effective_date"
.Tag = "effective_date"
.SetPlaceholderText Text:="Effective date"
End With
rng.Text = " | Effective Date: "
rng.Collapse wdCollapseStart
With rng.ContentControls.Add(wdContentControlRichText)
.Title = "revision_num"
.Tag = "revision_num"
.SetPlaceholderText Text:="Rev Num"
End With
rng.Text = " | Rev. "
rng.Collapse wdCollapseStart
With rng.ContentControls.Add(wdContentControlRichText)
.Title = "asset_id"
.Tag = "asset_id"
.SetPlaceholderText Text:="Asset ID"
End With
End Sub
Sign in to answer