如何在Word表中复制行？

Question

我正在尝试使用VBA复制Word中的表行，而不使用Selection对象或剪贴板。也就是说，我想要一个与现有行具有相同内容的新行。

为此，我首先创建一个新的（空）行，然后遍历源行中的每个单元格，并将其内容复制到目标行中的相应单元格中。

为了复制每个单元格，我得到一个引用源单元格的整个内容的Range对象，以及目标单元格的等效Range，然后执行以下操作：

oToRange.FormattedText = oFromRange.FormattedText

这在Office 2003上运行良好，并且大部分时间都在Office 2010上运行。但是，我遇到了一个特定情况的真正问题。我（大大）简化了这个场景，以展示问题的核心。

在下图中，外（灰色）2R x 1C表中有两个单元格。第二行是要复制的行。第一行是我创建的新行，我要将第二行的内容复制到其中。

您会注意到第二行包含嵌套表。

当我在Word 2003中运行下面的代码时，它运行正常，我得到以下结果：

但是，在Word 2010中，相同的代码会产生以下结果：

如您所见，单元格内容已在目标表格单元格之前（和之外）插入。

值得一提的是，如果我在嵌套表之后放置一些东西，那么它不再是源单元格中的最后一个东西，那么就不会出现这个问题。

这是我正在使用的完整VBA代码：

Dim oDoc As Word.Document
Set oDoc = ThisDocument

Dim oFromRange As Range
Set oFromRange = ThisDocument.Tables(1).Cell(2, 1).Range
oFromRange.End = oFromRange.End - 1

Dim oToRange As Range
Set oToRange = ThisDocument.Tables(1).Cell(1, 1).Range
oToRange.End = oToRange.End - 1

oToRange.FormattedText = oFromRange.FormattedText

注意：必须调整源和目标范围的末尾，因为Cell.Range包含单元格结束标记，我不想复制它。

我可以做些什么来说服它将内容放在目标单元格内（如Word 2003那样），而不是之前呢？

Answer 1

希望我已正确理解您的查询......这不是您要做的吗？此代码将复制表的第1行并在其下创建该行的副本。

Sub Sample()
    Dim tbl As Table

    Set tbl = ActiveDocument.Tables(1)

    tbl.Rows(1).Range.Copy
    tbl.Rows(1).Select
    Selection.InsertRowsBelow
    tbl.Rows(2).Range.Paste
End Sub

<强>截图

关注（来自评论）

此代码不使用Selection对象

Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(2).Range.Copy
    tbl.Rows(1).Range.Paste
End Sub

更多关注（来自评论）

Sub Sample()
    Dim tbl As Table
    Dim rowNew As Row

    Set tbl = ActiveDocument.Tables(1)
    Set rowNew = tbl.Rows.Add(BeforeRow:=tbl.Rows(1))
    tbl.Rows(1).Range.FormattedText = tbl.Rows(2).Range.FormattedText
    '~~~> This is required as the above code inserts a blank row in between
    tbl.Rows(2).Delete
End Sub

Answer 2

Function duplicate_row(ByRef ontable, rownnumber) As Row
 Dim c
 Dim fromrow As Row
 Dim newrow As Row
 Set fromrow = ontable.Rows(rownnumber)
 Set newrow = ontable.Rows.Add
 newrow.Range.FormattedText = fromrow.Range.FormattedText
 ontable.Rows(ontable.Rows.Count).Delete
 Set duplicate_row = newrow
End Function



Sub test()
 Dim newrow As Row

 Set newrow = duplicate_row(ActiveDocument.Tables(1), 2)
 newrow.Range.Find.Execute FindText:="text_service", ReplaceWith:="aaa", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_amount", ReplaceWith:="500", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_price", ReplaceWith:="50", Replace:=wdReplaceAll
 newrow.Range.Find.Execute FindText:="text_comment", ReplaceWith:="bbb", Replace:=wdReplaceAll

' ActiveDocument.Tables(1).Rows(1).Delete ' after adding all rows, delete the tempalte row
End Sub