将word文件中多个表格复制到单页上

仰望い天空的藍

word文件有好多页，每页中有三个表格，现在需要把所有表格按顺序复制到新文件，每个表格占用一页。

ming0018

下午有空给你写一个

仰望い天空的藍

ming0018 发表于 2019-12-24 11:58
下午有空给你写一个

感谢，终于找到人了

kingtau

1. Sub 提取表格1()
   
2.     Dim i, docNew As Document
   
3.     On Error Resume Next
   
4.     Set docNew = Documents.Add
   
5.             docNew.PageSetup.TopMargin = CentimetersToPoints(0)
   
6.             docNew.PageSetup.BottomMargin = CentimetersToPoints(0)
   
7.         For i = ThisDocument.Tables.Count To 1 Step -1
   
8.             docNew.Range(0, 0).FormattedText = ThisDocument.Tables(i).Range
   
9.             docNew.Tables(1).Rows.HorizontalPosition = MillimetersToPoints(18.8)
   
10.             If i <> 1 Then docNew.Range(0, 0).InsertBreak Type:=wdPageBreak
    
11.         Next
    
12. End Sub
    

复制代码

仰望い天空的藍

kingtau 发表于 2019-12-25 13:35

试了下，不行啊，怎么操作的呢。

kingtau

代码需要放在当前文档，不能放在模板上

kingtau

原理是把活动文档内的所有表格提取出来放在新建文档里，每个表格一页并居中，不破坏原文件。

ming0018

写得差不多了，下班了，明天上传给你。

仰望い天空的藍

kingtau 发表于 2019-12-25 16:34
原理是把活动文档内的所有表格提取出来放在新建文档里，每个表格一页并居中，不破坏原文件。

特别感谢，忘了说一点，每个表格提取出来需要保证其格式不被改动（行高、列宽、文字大小和位置），不需要居中，最好是靠左边，我用你的宏命令在源文件里加载运行，弹出来一个word文件，但是是空白的。我还有好几千个文件需要改，需要你的方法。

ming0018

代码在附件中。自己用吧