请教：如何将文档指定页码的内容复制到新文档

henterwu

请教：如何将文档指定页码的内容复制到新文档

如题。

如显示对话框：输入3,6-8,10,15-20

将上述范围的内容复制到新文档。

如何实现？谢谢！！！

wenz

我认为楼主的这个要求不如这么做：从后面做起，删除不要的页，另存为。

守柔

这个问题很有挑战性，我目前已大致解决，受时间关系可能要到明天才能发贴。

此问题的关键是解决如何提取出如连续输入：“1,3,5,7-11,13"等等的页数.(已解决)

请楼主耐心等一段时间.

办公之星

以下是引用守柔在2004-6-18 16:36:00的发言：

这个问题很有挑战性，我目前已大致解决，受时间关系可能要到明天才能发贴。

此问题的关键是解决如何提取出如连续输入：“1,3,5,7-11,13"等等的页数.(已解决)

请楼主耐心等一段时间.

　　守柔干脆上街摆摊得了^-^

henterwu

谢谢守柔老师，耐心恭候！！！

守柔

请楼主参考并运行以下程序，受时间限制，对一些判断错误未予详细规定写入代码，请及时反馈运行情况，以便及时修改！

Sub CopySel() Dim PageSel As String, i As Cell, PageNumber As Integer, MyNumber As Integer, StartPage As Integer, EndPage As Integer Dim MyRange As Range, Range2 As Range, StartRange As Long, EndRange As Long, n As Integer On Error GoTo errhandel PageSel = InputBox("请输入需要定位的页数!,号表示非连续页,-号表示连续页", "Microsoft Word") Application.ScreenUpdating = False Documents.Add ActiveDocument.SaveAs FileName:="temp1.doc" Selection.InsertAfter PageSel Application.DefaultTableSeparator = "," Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator Documents.Add ActiveDocument.SaveAs FileName:="temp2.doc" For Each i In Documents("temp1.doc").Tables(1).Range.Cells If i.Range.Text Like "*-*" = True Then For n = 1 To Len(i.Range.Text) - 1 If Mid(i.Range.Text, n, 1) = "-" Then MyNumber = n - 1 StartPage = CInt(Mid(i.Range.Text, 1, MyNumber)) EndPage = CInt(Mid(i.Range.Text, MyNumber + 2, Len(i.Range.Text) - 1 - MyNumber - 2)) With Documents("test.doc") .Activate Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=StartPage StartRange = Selection.Start Range(Start:=0, End:=0).Select Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=EndPage + 1 EndRange = Selection.Start Set MyRange = Range(Start:=StartRange, End:=EndRange) MyRange.Select Selection.Copy Set Range2 = Documents("temp2.doc").Content Range2.Collapse Direction:=wdCollapseEnd Range2.Paste End With Exit For End If Next Else PageNumber = CInt(Mid(i.Range.Text, 1, Len(i.Range.Text) - 1)) With Documents("test.doc") .Activate Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=PageNumber StartRange = Selection.Start Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=PageNumber + 1 EndRange = Selection.Start Set MyRange = Range(Start:=StartRange, End:=EndRange) MyRange.Select Selection.Copy Set Range2 = Documents("temp2.doc").Content Range2.Collapse Direction:=wdCollapseEnd Range2.Paste End With End If Next Documents("temp1.doc").Close (False) Application.ScreenUpdating = True Exit Sub errhandel: MsgBox "请检查页号或者页码输入是否有误,或者超出文档的范围!"

End Sub

守柔

请楼主注意,主控文档在该程序中设为"test.doc"(需要楼主作必要修改),而选择性粘贴的文档在代码中已设置为"temp2.doc",具体原理等有空再作解释.

henterwu

谢谢！！！

henterwu

测试下来，有两个现象，由于对此宏不能很好的理解，所以无法修改，

只能作为文件级宏使用，否则Range出错； 无法复制最后一页的内容，否则报超范围

为什么只有在出错的情况下才显示temp1，为什么这样设计？

再次谢谢守柔的多次帮助！！！

守柔

Sub CopySel() Dim PageSel As String, i As Cell, PageNumber As Integer, MyNumber As Integer, StartPage As Integer, EndPage As Integer Dim MyRange As Range, Range2 As Range, StartRange As Long, EndRange As Long, n As Integer, PageCount As Integer On Error GoTo errhandel PageCount = Selection.Information(wdNumberOfPagesInDocument) PageSel = InputBox("请输入需要定位的页数!,号表示非连续页,-号表示连续页", "Microsoft Word") If PageSel = "" Then Exit Sub Application.ScreenUpdating = False Documents.Add ActiveDocument.SaveAs FileName:="temp1.doc" Selection.InsertAfter PageSel Application.DefaultTableSeparator = "," Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator Documents.Add ActiveDocument.SaveAs FileName:="temp2.doc" For Each i In Documents("temp1.doc").Tables(1).Range.Cells If i.Range.Text Like "*-*" = True Then For n = 1 To Len(i.Range.Text) - 1 If Mid(i.Range.Text, n, 1) = "-" Then MyNumber = n - 1 StartPage = CInt(Mid(i.Range.Text, 1, MyNumber)) If StartPage >= PageCount Then GoTo errhandel EndPage = CInt(Mid(i.Range.Text, MyNumber + 2, Len(i.Range.Text) - 1 - MyNumber - 2)) With Documents("test.doc") .Activate Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=StartPage StartRange = Selection.Start If EndPage = PageCount Then Selection.EndKey Unit:=wdStory EndRange = Selection.Start Else Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=EndPage + 1 EndRange = Selection.Start End If Set MyRange = Range(Start:=StartRange, End:=EndRange) MyRange.Select Selection.Copy Set Range2 = Documents("temp2.doc").Content Range2.Collapse Direction:=wdCollapseEnd Range2.Paste End With Exit For End If Next Else PageNumber = CInt(Mid(i.Range.Text, 1, Len(i.Range.Text) - 1)) If StartPage > PageCount Then GoTo errhandel With Documents("test.doc") .Activate Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=PageNumber StartRange = Selection.Start If PageNumber = PageCount Then Selection.EndKey Unit:=wdStory EndRange = Selection.Start Else Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=PageNumber + 1 EndRange = Selection.Start End If Set MyRange = Range(Start:=StartRange, End:=EndRange) MyRange.Select Selection.Copy Set Range2 = Documents("temp2.doc").Content Range2.Collapse Direction:=wdCollapseEnd Range2.Paste End With End If Next Documents("temp1.doc").Close (False) Application.ScreenUpdating = True Exit Sub errhandel: Documents("temp1.doc").Close (False) Documents("temp2.doc").Close (False) MsgBox "请检查页号或者页码输入是否有误,或者超出文档的范围!"

End Sub TO：henterwu:

受活动文档限制及一个中间文档的限制，该程序只限于文件级宏中使用，不宜用于全局宏中。

另外你说的最后一页确实存在这个问题已作修改请另外再测试一下。

此程序的要点是判断INPUTBOX 中的输出无论有多少“," 及"-" 号,均在"temp1.doc" 中, 以文字转换为表格的形式将其分开这是该程序的精华所在否则无法作出正确的判断到底有几页和连续的有几页(通过FOR EACH 在表格间循环并获得相应页数当得到相应页数后进行定位取得用户的选择性页号范围,MYRANGE=该页的起始RANGE位置和下一页的起始位置即该页的MYRANGE范围.