WORD同时选择表格和含数字段落的方法

hzj2014

我把原始的WORD文档发上来吧，
要求一次性选择所有包含数字的段落 (但如果段落中的数字只有开头编号的话则不能算哦），以及所有的表格（最好是能选含有数字的表格），我要同时选择它们复制到一个空白文档中。
谢谢了。

hzj2014

怎么发不上来呢？附件太大吗，也只有3M啊

413191246se

楼主，你不能直接上传 .doc 文件，需要压缩为 .zip .rar 才行。另外，我的代码在我的电脑上 OK！

hzj2014

我当然知道压缩成rar啊，
我再试一下，选择高级模式，添加附件，不得，文件太大，我再分割成两个文件， 消防 第3篇.part1.rar (2 MB, 下载次数: 32)

2015-10-29 18:52 上传

点击文件名下载附件

消防 第3篇.part2.rar (1.73 MB, 下载次数: 61)

2015-10-29 18:52 上传

点击文件名下载附件

，这下应该得了。

413191246se

楼主，你这个灭火器知识文档，很好！——但对于你的要求，不敢苟同。只选含有数字的段落和表格，连表头都不想要，太断章取义了，不知为何要这样要求。

hzj2014

哦，其实我当然是要包含文本基本框架的，都能包括那是最好了，如第几章，第几节，只是为了简化这个问题才没说而已，因为我原先所发帖子的要求就已经挺难实现了。

hzj2014

大家还有什么办法吗，
那退一步吧，只选择表格以及表格上面的说明文字，怎么做呢。
我试过论坛上的VBA代码，是可以选择所有表格的文字内容，但将其复制到新文档时，得到的只是分成无数段落的文字内容，根本不是整张表格方框啊。

413191246se

楼主，你留下那些数字和表格到底是为了什么？下面是《微软官方VBA帮助里面的》宏-----将活动文档中的所有表格复制到新文档中----本示例将当前文档中的表格复制到新文档中。

Sub CopyTablesToNewDoc()
    Dim docOld As Document
    Dim rngDoc As Range
    Dim tblDoc As Table

    If ActiveDocument.Tables.Count >= 1 Then
        Set docOld = ActiveDocument
        Set rngDoc = Documents.Add.Range(Start:=0, End:=0)
        For Each tblDoc In docOld.Tables
            tblDoc.Range.Copy
            With rngDoc
                .Paste
                .Collapse Direction:=wdCollapseEnd
                .InsertParagraphAfter
                .Collapse Direction:=wdCollapseEnd
            End With
        Next
    End If
End Sub

hzj2014

谢谢楼上的，我试了你的代码，是可以复制表到新文档，但我还想把表前面的那段说明文字一起复制进去，比如“表3-3-10　水幕系统设计基本参数”这一行介绍说明文字，要跟表格一起复制到新文档，怎么实现呢。

我留下那些数字和表格，是因为文档太大了，我要考试只能挑重要内容来看，而数字记忆是选择题考试的重点，我要把它们抽出来重点学习，当然基本的章节标题内容最好也是要能同时保留。

山菊花

hzj2014 发表于 2015-10-30 21:37
谢谢楼上的，我试了你的代码，是可以复制表到新文档，但我还想把表前面的那段说明文字一起复制进去，比如“ ...

楼上的代码可改为如下，即包含标题：

1. Sub CopyTablesToNewDoc()
   
2.     Dim docOld As Document
   
3.     Dim rngDoc As Range
   
4.     Dim tblDoc As Table
   
5.      If ActiveDocument.Tables.Count >= 1 Then
   
6.          Set docOld = ActiveDocument
   
7.          Set rngDoc = Documents.Add.Range(Start:=0, End:=0)
   
8.          For Each tblDoc In docOld.Tables
   
9.             docOld.Range(tblDoc.Range.Previous.Paragraphs(1).Range.Start, tblDoc.Range.End).Copy
   
10.              With rngDoc
    
11.                  .Paste
    
12.                  .Collapse Direction:=wdCollapseEnd
    
13.                  .InsertParagraphAfter
    
14.                  .Collapse Direction:=wdCollapseEnd
    
15.              End With
    
16.          Next
    
17.      End If
    
18. End Sub

复制代码