不连续选择区域与反选（VBA）

不连续区域的选择与反选
作者：Konggs

声明：感谢C81兄的提醒
前言：“对非连续文本区域的研究与探索”是老大以前的研究，以前大家都很想知道是不是有其他的办法。但可惜水平太次。
感想：正是验证一句：“机会”总是属于有准备的人。今天：（2006.11.16）在不经意间看到C81兄的贴子，脑子一动，灵感一闪。出此小稿，供后来者斧正。
老大以前研究的地址：http://club.excelhome.net/viewthread.php?tid=83670&replyID=&skin=0  真是“有心栽花化不开，无心插柳柳成荫”

原理：
以下是我的想法的来源与思路（授人以鱼，不如授人以渔）
一、想法来源：看到C81兄在此贴（http://club.excelhome.net/viewthread.php?tid=200266&px=0）的一句话“但只要稍变一下就可以达到楼主目的，即想办法“反选”下就可以了”
二、我想为什么不把他利用到VBA进行多重不连续区域的选择呢？
三、利用保护文档，实行多块的一次性选择
四、要测试本方法，可以在本文档中的“工具栏”找到“不连续区域选择”按钮进行测试或者点“反选”、“查找内容选中”。
五、当然我演示的选中第一、三、五段，其实还可以有很多的扩展。
六、“查找内容选中”只是一个简单的扩展，我想还有很多、很多。

代码如下：
'===========================================
'此代码测试环境为：XP SP2＋word2003 sp2
'时间:2006-11-16 11:45分完成
'整理及测试人： konggs
'感谢：老大的帮助与C81的提醒
'===========================================
'此事例演示多重选择
'此例选择第一、三、五段，其它类推
Sub 不连续区域选择()
    Dim selRange As Range
   
    On Error Resume Next
   
   Application.ScreenUpdating = False
   
   '判断文档是否已经保护
   If ActiveDocument.ProtectionType >= 0 Then
      MsgBox "此文档已保护，不能进行多重选择", vbQuestion + vbOKOnly, "konggs提醒！one"
      Exit Sub
   End If
  
   '判断文档是否有5段
   If ActiveDocument.Paragraphs.Count < 5 Then
      MsgBox "此文档没有五段，不满足测试条件", vbQuestion + vbOKOnly, "konggs提醒！two"
      Exit Sub
   End If
  
    Dim objEditor As Editor
    '表示已被分配特定权限可编辑部分文档的单个用户。
    '可授予权限的用户包括单独的捐赠者以及为“文档工作区”站点定义的用户组。
   
    '得到三个Editor 对象
    Set selRange = ActiveDocument.Paragraphs(1).Range
    Set selRange = selRange.Editors.Add(wdEditorEveryone)
   
    Set selRange = ActiveDocument.Paragraphs(3).Range
    Set objEditor = selRange.Editors.Add(wdEditorEveryone)
   
    Set selRange = ActiveDocument.Paragraphs(5).Range
    Set objEditor = selRange.Editors.Add(wdEditorEveryone)
   
   
'    利用保护文档来选中
    ActiveDocument.Protect Password:="", NoReset:=False, Type:= _
        wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
    ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
    ActiveDocument.Unprotect
   
  '去掉选中的Editor对象
        Set objEditor = Selection.Editors(1)
        objEditor.DeleteAll
       
    '任务窗格不显示
    CommandBars("Task Pane").Visible = False

    Application.ScreenUpdating = True
   
End Sub

反选注意：只有选中一个区域的反选，即多重选择中最后的那一个区域。

反选的代码如下：
Sub 反选()

    On Error Resume Next
    Application.ScreenUpdating = False
   
    '判断是否存在此书签
    If ActiveDocument.Bookmarks.Exists("konggs") Then
       ActiveDocument.Bookmarks("konggs").Delete
    End If
   
    '判断选中所在的页
    Dim startPage As Long
    Dim rowLine%, allLine
    startPage = Selection.Information(wdActiveEndPageNumber)  '判断当前所在页
    rowLine = Selection.Information(wdFirstCharacterLineNumber)  '判断当前所在行
    allLine = Selection.PageSetup.LinesPage '判断此页的页面设置总行数
   
    '添加书签
    Dim addBookMark As Bookmark
    Set addBookMark = Selection.Bookmarks.Add("konggs", Selection.Range)
    Dim a As Range, b As Range
   
    '设置除书签外的所有区域
    Set a = ActiveDocument.Range(0, addBookMark.Range.Start)
    Set b = ActiveDocument.Range(addBookMark.Range.End, ActiveDocument.Range.End - 1)
   
    '添加到区域
    a.Editors.Add wdEditorEveryone
    b.Editors.Add wdEditorEveryone
    '保护文档
    ActiveDocument.Protect Password:="", NoReset:=False, Type:= _
    wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
    '选中所有的区域
    ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
    '去除保护文档
    ActiveDocument.Unprotect
    '去除所有的区域
    Dim objeditor As Editor
    Set objeditor = Selection.Editors(1)
        objeditor.DeleteAll
    '删除书签konggs
    ActiveDocument.Bookmarks("konggs").Delete
   
    '确定屏幕的滚动
    Dim endPage As Long
    endPage = Selection.Information(wdActiveEndPageNumber) '确定当前选中区域最后所在页
       
        ActiveWindow.PageScroll up:=endPage - startPage  '确定滚四页
        ActiveWindow.SmallScroll up:=allLine - rowLine '确定流四行
       
        Application.ScreenUpdating = True
   
End Sub

“查找内容选中”没有在本文中，在后台（VBA）中

特此声明：
时间有限，我想绝对还有很好的方法。
只是今天非常高兴，所以，马上整理放上来。与大家分享。
请老大指点。
题外话：word功能很多，我想我们只是碰到一点皮毛而已。所以，继续研究中。。。

Konggs  2006.11.16   21:30整理完成   

mhaxeznD.rar (20.27 KB)

[此贴子已经被作者于2006-11-16 21:29:45编辑过]

可恶的文字限制！是可忍孰不可忍！浪费我很长时间了！

我在孔兄基础和原理上，马不停蹄，写了一个代码，经多次测试，尚有一些不太令人满意的地方，一并请孔兄测试：
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2006-11-17 7:28:55
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0097^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub UnSelected()
    Dim myRange As Range, oEditor As Editor
    On Error Resume Next
    '判断当前Word应用程序版本,如低于2003则退出
    If Application.Version < 11 Then Exit Sub
    '如果所选内容为非常规文本则退出
    If Selection.Type <> wdSelectionNormal Then Exit Sub
    With ActiveDocument
        '如果文档处于保护状态时则退出
        If .ProtectionType <> wdNoProtection Then Exit Sub
        Application.ScreenUpdating = False
        '显示隐藏文字
        .ActiveWindow.View.ShowHiddenText = True
        '将主文档设置为用户可编辑区域
        .Content.Editors.Add wdEditorEveryone
        '选所选内容的文字设置为隐藏文字(此处旨在最大限度应用区别的格式设置)

[此贴子已经被作者于2006-11-17 7:31:18编辑过]

        Selection.Font.Hidden = True
        '定义一个RANGE对象为主文档区域
GN:         Set myRange = .Content
        With myRange.Find    '查找隐藏文字
            .ClearFormatting
            .Font.Hidden = True
            Do While .Execute = True    '成功查找时
                myRange.Select    '此句代码本不需,但发现会出错
                myRange.Editors(wdEditorEveryone).Delete    '删除可编辑权限
                '即先将全文档赋予所有人员的可编辑权限,再将所选内容的可编辑权限删除
                myRange.Font.Hidden = False    '恢复常规字体
                GoTo GN    '返回指定代码行
            Loop
        End With
        '不显示用户可编辑区域的底纹
        .ActiveWindow.View.ShadeEditableRanges = False
        .SelectAllEditableRanges (wdEditorEveryone)    '选择所有可编辑区域
    End With
    Application.ScreenUpdating = True
End Sub
'----------------------

wHqaYMdu.rar (10.63 KB)

谢谢老大。感觉非常不错了。

有不足是难免的，看来等以后的高手来突破了。

感觉已经能满足99%的要求了。

不错,谢谢二位.

Word 的Range对象好象不能象EXCEL中那样合并?

请问如何将附件文挡中反向功能按钮加
到自已的word 程序中
谢谢

[ 本帖最后由 euroshooter 于 2010-1-1 20:40 编辑 ]

反向选择这个功能很好，可是就是没有，需要能编程实现，确实是不错。