[求助]如何快速复制文档的偶数页？

qzhsy

由于工作需要WORD文档中我只要保留偶数页的内容，如2，4，6……

但是工作表太大一页一页的自制太慢了，请问一下有什么比较快的方法？

谢谢！

守柔

以下是引用qzhsy在2005-9-15 10:10:21的发言：

由于工作需要WORD文档中我只要保留偶数页的内容，如2，4，6……

但是工作表太大一页一页的自制太慢了，请问一下有什么比较快的方法？

谢谢！

使用VBA吧，更方便。

我简单地做了一个，请测试。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-9-15 10:59:22 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 00026^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub CopyDouPages() Dim i As Integer, lngStart As Long, lngEnd As Long, myRange As Range Dim NewDoc As Document, PagesCount As Integer On Error Resume Next '忽略错误 Application.ScreenUpdating = False '关闭屏幕更新,加快运行速度 Set NewDoc = Documents.Add '新建一个空白文档 With ThisDocument '取得本文档的总页数 PagesCount = .Content.Information(wdNumberOfPagesInDocument) For i = 2 To PagesCount Step 2 '从第二页开始一个循环 '取得当前页的起点 lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start '取得下一页的起点,如果是最后一页,则为文档结束位置 lngEnd = VBA.IIf(i = PagesCount, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + 1).Start) Set myRange = .Range(lngStart, lngEnd) '定义一个RANGE对象 ' myRange.Select myRange.Copy '复制偶数页 With NewDoc.Content .Collapse wdCollapseEnd '折叠到文档末 '保留源格式粘贴 .PasteAndFormat (wdFormatOriginalFormatting) End With Next End With Application.ScreenUpdating = True '恢复屏幕更新 End Sub '----------------------

qzhsy

谢谢守柔版主！