5

我正在尝试使用 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 一样），而不是在它之前？

4

2 回答 2

9

希望我已经正确理解了您的查询...这不是您想要做的吗？此代码将复制表格的第 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
于 2013-09-12T18:12:53.927 回答
1 
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
于 2018-08-01T09:01:28.697 回答