|
不连续区域的选择与反选
作者：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, 下载次数: 161)
[此贴子已经被作者于2006-11-16 21:29:45编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-11-16 21:26
发表于 2006-11-17 07:29
楼主
