vba 如何在 Word 表格中复制一行？

How can I duplicate a row in a Word table?

提问by Gary McGill

I am trying to duplicate a table row in Word, using VBA, without using the Selection object or the clipboard. That is, I want a new row that has the same content as an existing row.

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

To do this, I first create a new (empty) row, and loop through each cell in the source row and copy its contents into the corresponding cell in the target row.

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

To copy each cell, I get a Rangeobject that references the entire content of the source cell, and an equivalent Rangefor the target cell, and then do this:

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

oToRange.FormattedText = oFromRange.FormattedText

This works well on Office 2003, and also works most of the time on Office 2010. However, I am having a real problem with one particular scenario. I have (greatly) simplified that scenario to demonstrate the core of the problem.

这在 Office 2003 上运行良好，并且在大多数情况下也适用于 Office 2010。但是，我在一个特定场景中遇到了真正的问题。我已经（极大地）简化了该场景以演示问题的核心。

In the picture below, there are two cells in the outer (grey) 2R x 1C table. The second row is the row to be copied. The first row is the new row I created, and into which I want to copy the content of the second row.

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

You'll notice that the second row contains a nested table.

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

When I run the code below in Word 2003, it works perfectly, and I get the following result:

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

But, in Word 2010, the same code produces this result:

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

As you can see, the cell content has been inserted before(and outside) the target table cell.

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

It's worth mentioning that if I put something after the nested table, so that it's no longer the last thing in the source cell, then this problem does not occur.

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

Here's the full VBA code I'm using:

这是我正在使用的完整 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

NOTE: the adjustment to the end of the source and target ranges is necessary because Cell.Rangeincludes the end-of-cell marker, and I don't want to copy that.

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

What can I do to persuade it to put the content insidethe target cell (like Word 2003 does), rather than before it?

我该怎么做才能说服它把内容放在目标单元格内（就像 Word 2003 那样），而不是放在它之前？

回答by Siddharth Rout

Hope I have understood your query correctly... Isn't this what you are trying to do? This code will copy Row 1 of the table and create a copy of that row below it.

希望我已经正确理解了您的查询......这不是您想要做的吗？此代码将复制表的第 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

Screenshot

截屏

FOLLOWUP(From Comments)

跟进（来自评论）

This code doesn't use the Selectionobject

此代码不使用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

MORE FOLLOWUP(From Comments)

更多跟进（来自评论）

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

回答by Shimon Doodkin

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