一个关于选定区域的问题

小小小玲

就比如说一个500多页的word 文档，怎么都很方便的选取自己想要的页数，比如说只选取中间的几百页，除了拖动的方法，有没有更好的办法，请指教！

chylhr

鼠标拖动的方法适合于当前显示的界面内,跨多页时,使用Shift键更合适:单击要选定内容的起始处,然后拖动滚动条到选定内容的结尾处,在按住Shift键的同时单击鼠标左键即可.

小小小玲

谢谢了，如果是不连续的选取呢？比如说，选取第100页，第200页，第302页，这怎么选取，只选取这3页？

konggs

打破沙锅问到底？

试试下面的代码行否？

Option Explicit
'======================================================================================================
'功能：完成选中任何不连续的页的内容
'要求：必须按照输入打印时的页码范围的形式输入
'      即不连续的单页用短句；连续的几页用-；全部是半角；连续时，前面是较小的数，后面是较大的数，等等
'测试环境：winxpsp2+word2003
'CodeWriter:kongguisheng  2007.04.23 10:00
'======================================================================================================
Sub SelectCustomPage()
    Dim mypages
    Dim arr1
    
    On Error Resume Next
   
    mypages = InputBox("输入页数，与打印一样，间隔用短号，连续用-", "konggs", "1") '得到输入的内容
    '判断是否合法
    If Not IsNumeric(Replace(Replace(mypages, ",", ""), "-", "")) Then
        If mypages = "" Then
            MsgBox "你按下了取消或没输入任何内容", 64 + 1, "konggs"
        Else
            MsgBox "此输入有非法字法", 64 + 1, "konggs": Exit Sub
        End If
    End If
    '得到各个对应的页数
    mypages = myallpages(mypages, ThisDocument.Range.Information(wdActiveEndPageNumber))
  
    Application.ScreenUpdating = False
    '预防性删除
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    '把每页的区域添加到编辑区
    For Each arr1 In mypages
       Selection.GoTo What:=wdGoToPage, Name:=arr1
       ThisDocument.Bookmarks("\Page").Range.Editors.Add (wdEditorEveryone)
    Next
    '选中所有的编辑区
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
   
    Application.ScreenUpdating = True
   
End Sub

Function myallpages(mypages, numpage)
    Dim arr1, temparr1
    Dim arr2
    arr1 = Split(mypages, ",")
    ReDim arr2(0)
    Dim findint%, j%, i%

    For Each temparr1 In arr1
   
        findint = InStr(1, temparr1, "-")
       
        If findint > 0 Then
          
           For j = Mid(temparr1, 1, findint - 1) To Mid(temparr1, findint + 1, Len(temparr1) - findint)
              If j > numpage Then  '如果输入的数字大于总数则跳出循环,否则会影响速度
                 Exit For
              End If
               ReDim Preserve arr2(i)
               arr2(i) = j
               i = i + 1
           Next
          
        Else
           ReDim Preserve arr2(i)
           arr2(i) = CInt(temparr1)
           i = i + 1
        End If
    Next
    myallpages = arr2
   
End Function

chylhr

'konggs兄的方法甚妙,不过老兄好象没有调试啊，有点小问题,在你代码的基础上我稍做修改,老兄莫怪。

Sub SelectCustomPage()
    Dim mypages
    Dim arr1
    
    On Error Resume Next
   
    mypages = InputBox("输入页数，与打印一样，间隔用短号，连续用-", "konggs", "1") '得到输入的内容
    '判断是否合法
    If Not IsNumeric(Replace(Replace(mypages, ",", ""), "-", "")) Then
        If mypages = "" Then
            MsgBox "你按下了取消或没输入任何内容", 64 + 1, "konggs"
        Else
            MsgBox "此输入有非法字法", 64 + 1, "konggs": Exit Sub
        End If
    End If
    '得到各个对应的页数
    mypages = myallpages(mypages, ActiveDocument.Range.Information(wdActiveEndPageNumber))
   '若用ThisDocument则只能把宏放在当前文档中了（不能放入模板中）
    Application.ScreenUpdating = False
    '预防性删除
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    '把每页的区域添加到编辑区
    For Each arr1 In mypages
       Selection.GoTo What:=wdGoToPage, Count:=arr1
       ActiveDocument.Bookmarks("\Page").Range.Editors.Add (wdEditorEveryone)
    Next
    '选中所有的编辑区
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
   
    Application.ScreenUpdating = True
   
End Sub

Function myallpages(mypages, numpage)
    Dim arr1, temparr1
    Dim arr2
    arr1 = Split(mypages, ",")
    ReDim arr2(0)
    Dim findint%, j%, i%

    For Each temparr1 In arr1
   
        findint = InStr(1, temparr1, "-")
       
        If findint > 0 Then
          
           For j = Mid(temparr1, 1, findint - 1) To Mid(temparr1, findint + 1, Len(temparr1) - findint)
              If j > numpage Then  '如果输入的数字大于总数则跳出循环,否则会影响速度
                 Exit For
              End If
               ReDim Preserve arr2(i)
               arr2(i) = j
               i = i + 1
           Next
          
        Else
           ReDim Preserve arr2(i)
           arr2(i) = CInt(temparr1)
           i = i + 1
        End If
    Next
    myallpages = arr2
   
End Function

[此贴子已经被作者于2007-4-23 17:54:38编辑过]

konggs

谢谢chylhr兄的指正。

我调试过的，不过，没有细调，只放在当前文档的thisdocument运行正常就马上放上来了。

上班时间到了，也不敢老在哪里搞这个。呵呵。

小小小玲

谢谢两位高手，虽然看不太懂[em04]