如何用VBA将文档中全部有纵向单元格合并的表格复制到另一新建文档中？

ssq1109

各位达人：
要求如题，即只将一文档中的全部有纵向单元格合并的表格复制到另一新建文档中，其他表格（包括有横向单元格合并的）都不管。
新文档另取名保存，如另存为NEW_ZB.DOC

sylun

可试试如下代码：

1. Sub test()
   
2.     Dim Doc As Document, Tbl As Table, i As Integer, n As Integer
   
3.     On Error Resume Next
   
4.     Application.ScreenUpdating = False
   
5.     With ActiveDocument
   
6.         Set Doc = Documents.Add
   
7.         For Each Tbl In .Tables
   
8.             i = Tbl.Rows(1).Index
   
9.             If Err = 5991 Then
   
10.                 n = n + 1
    
11.                 Doc.Bookmarks("\endofdoc").Range.FormattedText = Tbl.Range
    
12.                 Doc.Content.InsertParagraphAfter
    
13.                 Err.Clear
    
14.             End If
    
15.         Next
    
16.         Doc.SaveAs .Path & "" & "NEW_ZB.DOC"
    
17.     End With
    
18.     MsgBox "处理完毕！共复制了" & n & "个表格。"
    
19.     Application.ScreenUpdating = True
    
20. End Sub

复制代码

ssq1109

非常谢谢sylun！代码很好，且速度快。

4me

如何区分纵向单元格合并或横向单元格合并？

sylun

原帖由 4me 于 2010-12-25 23:30 发表
如何区分纵向单元格合并或横向单元格合并？

可试试如下代码：

1. Sub test()
   
2.     '判断插入点所在表格的单元格合并情况
   
3.     Dim i As Integer, TF As Boolean
   
4.     On Error Resume Next
   
5.     If Selection.Information(wdWithInTable) = False Then Exit Sub
   
6.     With Selection.Tables(1)
   
7.         i = .Rows(1).Index
   
8.         If Err = 5991 Then TF = True
   
9.         i = .Columns(1).Cells.Count
   
10.         If Err = 5992 Then
    
11.              MsgBox IIf(TF, "既有横向也有纵向合并", "只有横向合并")
    
12.         Else
    
13.             MsgBox IIf(Err, "只有纵向合并", "没有合并单元格")
    
14.         End If
    
15.     End With
    
16. End Sub

复制代码

如果要判断特定单元格的合并情况，可试试通过其行列属性与相邻单元格行列属性比较来判断。

4me

谢谢，留待后用。

wawapei

非常好的代码，我问一下sylun ，如何知道合并了几个单元格形成的合并单元格。

我的电子表1516

有启发，收藏了，谢谢大师们