以下是引用fatstone1975在2005-6-24 15:20:45的发言：
例如，我想挑出第5页和第7页另存为一个新的word 文档。
谢谢了
我在原有的基础上，修改了一下，适宜于挑出连续页的另存为WORD文档，请楼主试用之。
另外，我不道楼主随意说一下第5页、第7页，是否太随便了，你知道如果你先挑了第7页，再挑第5页，你让电脑明白，是先放7还是先放5啊？当然，您也可以挑任意页，但是，你得告诉我，你想如何才能得到你想要的结果？
请在文本中右击，然后按下"AnyPagesSelect"命令
以下代码供参考：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-6-24 15:49:04
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Private Sub Document_Close()
On Error Resume Next
Application.CommandBars("Text").Controls("AnyPagesSelect").Delete '恢复原有菜单
End Sub
'----------------------
'----------------------
Private Sub Document_Open() '参见自定义右键菜单
Dim Half As Byte
On Error Resume Next
Dim NewButton As CommandBarButton
Application.CommandBars("Text").Controls("AnyPagesSelect").Delete '预防性删除
Half = Int(Application.CommandBars("Text").Controls.Count / 2) '中间位置
Set NewButton = Application.CommandBars("Text").Controls.Add(Type:=msoControlButton, Before:=Half)
With NewButton
.Caption = "AnyPagesSelect" '命令名称
.FaceId = 100 '命令的FaceId
.Visible = True '可见
.OnAction = "Sample" '指定响应过程名
End With
End Sub
'----------------------
'----------------------
Sub Sample()
Dim P As String, PS() As String, PageHome As Integer, PageEnd As Integer, EndPage As Long
Dim MyRange As Range, NewDoc As Document
On Error Resume Next
P = InputBox(prompt:="请在此输入连续页的首页-尾页,以-为分隔符!", Title:="Word连续页选定")
If P = "" Then Exit Sub
PS = Split(P, "-") '返回一个以"-"分隔的一维数组
If UBound(PS) > 1 Then Exit Sub '如果上标大于1,则退出(用户连续型输入如1-2-7")
PageHome = PS(0) '首页为数组下标
PageEnd = PS(1) '尾页为数组上标
If PageHome > PageEnd Then Exit Sub '尾页大于首页则退出
If PageHome < 1 Then Exit Sub '首页小于1则退出
With ActiveDocument
'EndPage为尾页位置,如果大于文档总页数,则为文档最后位置;反之则下一页的起始位置
EndPage = VBA.IIf(PageEnd >= .GoTo(wdGoToPage, wdGoToNext, , PageEnd).Information _
(wdNumberOfPagesInDocument), .Content.End, _
.GoTo(wdGoToPage, wdGoToNext, , PageEnd + 1).Start)
'定义一个RANGE对象
Set MyRange = .Range(.GoTo(wdGoToPage, wdGoToNext, , PageHome).Start, EndPage)
If MsgBox("您想要将指定页的内容另存为WORD文件吗?", vbOKCancel + vbInformation) = vbOK Then
Set NewDoc = Documents.Add '定义一个新文档
With NewDoc
.Content = MyRange '将MyRange写入新文档中
'打开另存为对话框
Application.Dialogs(wdDialogFileSaveAs).Show
NewDoc.Close '关闭新文档
End With
End If
End With
End Sub
'----------------------
'---------------------
YQpnIxjw.zip
(13.07 KB, 下载次数: 73)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-6-24 15:20
发表于 2005-6-24 16:26