【问题标题】:VBA to add a row to the bottom of the table and insert Rich Text Content ControlVBA 在表格底部添加一行并插入富文本内容控件
【发布时间】:2018-04-23 12:38:10
【问题描述】:

我在 Word 2013 中有一个表格。里面有各种表格,我希望用户能够在表格底部添加一行。我已经使用以下代码完成了此操作:

`Dim oTable As table
Dim oCell As Cell
Dim oPrevRow as Row, oNewRow As Row
Dim iColumn As Long
Set oTable = ActiveDocument.tables (1)
Set oPrevRow = oTable.Rows(oTable.Rpws.Count)
oTable.Rows.Add
Set oNewRow = oTable.Rows(oTable.rows.Count)`

我想要的是让新行中的所有 7 个单元格都插入富文本内容控件。我该怎么做呢?

【问题讨论】:

  • 上一行是否也有相同的内容控件?
  • 嗨 Cindy,是的。
  • 这可以通过三种基本方式来处理: 1) 复制/粘贴最后一行,其中包括内容控件; 2)将此行另存为自动图文集(BuildingBlock)条目并根据需要插入; 3)(假设Word 2013或更高版本)将表格放在重复部分内容控件中,以便在用户单击+时自动生成新行。 Paul 提供的代码是 1... 的变体

标签: vba ms-word


【解决方案1】:

以下代码适用于文档正文中任何位置标记为“TblBkMk”的表格。代码中的注释显示了您可以如何测试特定表。只需将代码添加到文档或其模板的“ThisDocument”代码模块。当您退出表格中的最后一个内容控件时,宏会触发。该代码还为文档提供了“只读”或“填写表格”保护(如果您使用密码,请将密码添加到指定的代码中)

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 Long
Const Pwd As String = "" 'Insert password (if any) here
'Bookmarking the table provides the flexibility of being able to deal with the addition/deletion
' of other tables before the one we want to process.
Const StrBkMk As String = "TblBkMk"
'Exit if we're not in a table - we don't really need this is using a bookmarked table,
' but it's a safeguard against the bookmark having been expanded/moved.
If CCtrl.Range.Information(wdWithInTable) = False Then Exit Sub
With ActiveDocument
  If .Bookmarks.Exists(StrBkMk) = False Then
    MsgBox "The table bookmark: '" & StrBkMk & "' is missing." & vbCr & _
    "Please add it to the relevant table before continuing.", vbExclamation
    Exit Sub
  End If
End With
With CCtrl
  'Check that the Content Control is within our bookmarked table's range.
  If .Range.InRange(ActiveDocument.Bookmarks(StrBkMk).Range) = False Then Exit Sub
  ' One could test for a particular table instead, in which case all the code dealing
  ' with wdWithInTable & StrBkMk can be deleted. For example:
  'If .Range.InRange(ActiveDocument.Tables(1).Range) = False Then Exit Sub
  'Get the number 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
End With
'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
  'Update the bookmarked range
  .Bookmarks.Add Name:=StrBkMk, Range:=Selection.Tables(1).Range
  ' Re-protect the document, if applicable
  .Protect Type:=Prot, Password:=Pwd
End With
End Sub

【讨论】:

  • 感谢 macropod,我已将其放入,但在以下行中不断出现错误:.Next.InsertBefore vbCr
  • 上面的代码已经在其他论坛上发布过,没有人回来过这样的错误。您的表格使用什么包装格式以及遵循什么格式?
  • 嗨,macropod,它现在没有使用,后面还有第二张桌子。啊,现在我已经将包装更改为 around 并且可以正常工作 - 谢谢
  • 我怀疑它是“环绕”包装 - 除非下表也有。
猜你喜欢
  • 2018-03-03
  • 2020-06-18
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
相关资源
最近更新 更多