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

loquat

守柔大侠的代码有如下问题：
1.如果原文含有隐藏文字时，将会处理错误
2.如果选取包含文档结尾的段落标记时，代码会处理出错
如下代码解决第2个问题

1. Sub UnSelected_loquat()
   
2.     Dim aRange As Word.Range, docEnd&
   
3.     If Application.Version < 11 Then Exit Sub '判断当前Word应用程序版本,如低于2003则退出
   
4.     If Selection.Type <> wdSelectionNormal Then Exit Sub '如果所选内容为非常规文本则退出
   
5.     With ActiveDocument
   
6.         If .ProtectionType <> wdNoProtection Then Exit Sub '如果文档处于保护状态时则退出
   
7.         Application.ScreenUpdating = False
   
8.         .ActiveWindow.View.ShowHiddenText = True   '显示隐藏文字
   
9.         .ActiveWindow.View.ShadeEditableRanges = False '不显示用户可编辑区域的底纹
   
10.         Selection.Font.Hidden = True  '所选内容设置为隐藏文字
    
11.         Set aRange = .Content   '变量存储文档Range
    
12.         aRange.MoveEnd wdCharacter, -1  '排除非文档尾
    
13.         docEnd = aRange.End - 1         '文档末尾坐标
    
14.         With aRange.Find
    
15.             .ClearFormatting     '清除查找格式
    
16.             .Font.Hidden = False
    
17.             Do While .Execute = True '成功查找时
    
18.                 Set aRange = .Parent '重置Range对象,为查找到的目标区域
    
19.                 aRange.Editors.Add wdEditorEveryone  '使用可编辑区域保存
    
20.                 aRange.SetRange aRange.End, docEnd  '重置Range对象
    
21.             Loop
    
22.         End With
    
23.         Selection.Font.Hidden = False                '恢复正常文字属性
    
24.         .SelectAllEditableRanges (wdEditorEveryone)    '选择所有可编辑区域
    
25.         .DeleteAllEditableRanges (wdEditorEveryone)    '删除所有可编辑区域
    
26.     End With
    
27.     Application.ScreenUpdating = True
    
28. End Sub

复制代码

453507254

konggs版主你好，我学习了你的代码，编写了一段程序，用于替换一个文档里面的空格（中文之间，中文与英文之间），但是英文与英文之间的正常空格需要保留。在一些文档里面这个代码能成功，但是附件这个文档，运行程序失败

1.    Set objEditor =Selection.Editors(1)  但是这一句总是报错

请问是什么原因呢，这句代码的含义是什么，非常感谢

1. Sub sckg() '将全文空格删除，但是保留英文之间的正常空格'
   
2.     Application.ScreenUpdating = False
   
3.     Dim characters1, characters2, n As Long, t
   
4.     characters1 = ActiveDocument.Characters.Count
   
5.     t = Timer()
   
6.     Dim reg As Object
   
7.     Set reg = CreateObject("VBScript.RegExp") '创建正则对象
   
8.     Dim i, j, mt, oRang As Range, m%
   
9.     '首先将文档的不间断空格，全部替换成普通空格，不间断空格的输入方法是Ctrl+Shift+Space，显示为一个个小圆圈
   
10.     Selection.Find.ClearFormatting
    
11.     Selection.Find.Replacement.ClearFormatting
    
12.     With Selection.Find
    
13.         .Text = "^s"
    
14.         .Replacement.Text = " "
    
15.         .Forward = True
    
16.         .Wrap = wdFindContinue
    
17.         .Format = False
    
18.         .MatchCase = False
    
19.         .MatchWholeWord = False
    
20.         .MatchByte = True
    
21.         .MatchWildcards = False
    
22.         .MatchSoundsLike = False
    
23.         .MatchAllWordForms = False
    
24.     End With
    
25.     Selection.Find.Execute Replace:=wdReplaceAll
    
26.     '替换完成
    
27.     With reg
    
28.         .Pattern = "[^a-zA-Z]\s+|\s+[^a-zA-Z]" '这里各显其能输入正则表达式
    
29.         .Global = True: .IgnoreCase = False: .MultiLine = True
    
30.         For Each i In ActiveDocument.Paragraphs
    
31.             For j = .Execute(i.Range.Text).Count - 1 To 0 Step -1 '从一段最后一个匹配的对象往前查找，这样可以避免删除空格之后firstindex变化导致替换发生错误
    
32.                 Set mt = .Execute(i.Range.Text)(j)
    
33.                 m = mt.FirstIndex: n = mt.Length
    
34.                 Set oRang = ActiveDocument.Range(i.Range.Start + m, i.Range.Start + m + n)
    
35.                 Dim objEditor As Editor
    
36.                 '表示已被分配特定权限可编辑部分文档的单个用户。
    
37.                 '可授予权限的用户包括单独的捐赠者以及为"文档工作区"站点定义的用户组。
    
38.                 '得到三个Editor 对象
    
39.                 Set objEditor = oRang.Editors.Add(wdEditorEveryone)
    
40.             Next
    
41.         Next
    
42.         ActiveDocument.Protect Password:="", NoReset:=False, Type:= _
    
43.             wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
    
44.         ActiveDocument.SelectAllEditableRanges (wdEditorEveryone)
    
45.         ActiveDocument.Unprotect
    
46.         '去掉选中的Editor对象
    
47.         Set objEditor = Selection.Editors(1)
    
48.         objEditor.DeleteAll
    
49.         '任务窗格不显示
    
50.         CommandBars("Task Pane").Visible = False
    
51.         Application.ScreenUpdating = True
    
52.     End With
    
53.     With Selection.Find
    
54.         .ClearFormatting '取消查找的格式设置
    
55.         .Text = " " '查找内容
    
56.         .Replacement.ClearFormatting '取消需替换的格式设置
    
57.         .Replacement.Text = "" '替换的内容
    
58.         .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=False '执行全部替换，向前，到末尾继续从头查找
    
59.     End With
    
60.     Selection.ShrinkDiscontiguousSelection
    
61.     characters2 = ActiveDocument.Characters.Count
    
62.     n = characters1 - characters2
    
63.     MsgBox "共删除无用空格" & n & "个！" & vbNewLine & "用时：" & Format(Timer() - t, "0.000秒")
    
64.     Application.ScreenUpdating = True
    
65. End Sub

复制代码