Unable to Add Content Control to Table Cell

Lee Polikoff 21 Reputation points
2021-04-09T11:50:59.347+00:00

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
{count} votes

Your answer

Answers can be marked as Accepted Answers by the question author, which helps users to know the answer solved the author's problem.