使用合并的单元格复制表格行

时间:2013-01-30 21:21:54

标签: ms-word runtime-error word-vba

我需要插入一组行的多个副本,格式如下所示。

+-------------------------------------------------+
|                       1,1                       |
+-------------------------------------------------+
|         |   2,2   |         |   2,4   |         |
|   2,1   +---------+   2,3   +---------+   2,5   |
|         |   3,2   |         |   3,4   |         |
+-------------------------------------------------+
|                       4,1                       |
+-------------------------------------------------+
|         |   5,2   |         |   5,4   |         |
|   5,1   +---------+   5,3   +---------+   5,5   |
|         |   6,2   |         |   6,4   |         |
+-------------------------------------------------+

在案例A中,我需要在第4行之前插入第1-3行的多个副本。

在案例B中,我需要在表格末尾插入4-6行的多个副本。

table.rows(n)方法不起作用并给出以下错误:

  

运行时错误' 5991':

     

无法访问此集合中的各个行,因为该表具有垂直合并的单元格

但是,可以从用户界面执行此操作,因此必须可以!

1 个答案:

答案 0 :(得分:5)

以下是我如何克服该问题(在Word 2007和Word 2003中测试)

Sub CaseA()

    Dim D As Document, T As Table

    Set D = ActiveDocument

    Set T = D.Tables(1)     '   select the first table in the document
                '   select from the start of row 1 to the start of row 4
    D.Range(T.Cell(2, 1).Range.Start, T.Cell(4, 1).Range.Start).Select

    Selection.Copy          '   copy the rows
                            '   move the insertion point to the start of row 4
    Selection.Collapse wdCollapseEnd 

    Selection.Paste         '   insert a copy
                                    '   (can do this as many times as you want)

End Sub

Sub CaseB()

    Dim D As Document, T As Table

    Set D = ActiveDocument

    Set T = D.Tables(1)
' select from the start of row 5 to the end of the last cell present in row 6
' plus 1 character for column 5 plus 1 character to move outside the table
    D.Range(T.Cell(5, 1).Range.Start, T.Cell(6, 4).Range.End + 2).Select

    Selection.Copy          '   copy the rows
                            '   move the insertion point just outside the table
    Selection.Collapse wdCollapseEnd

    Selection.Paste         '   insert a copy

End Sub