我正在尝试使用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那样),而不是之前呢?
答案 0 :(得分:7)
希望我已正确理解您的查询......这不是您要做的吗?此代码将复制表的第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
答案 1 :(得分:0)
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