|
谢谢守版！在弹出“选项样式设置”时，总是会出现“控件工具栏”；在“确定”后，还会出现“退出设计模式”，如何才能在运行代码时不让其出现？ 用22楼的附件进行测试，发现代码怎么又不能做到行距自动统一设置了 [em06][em06][em06] Sub myReplace()
'基于选定内容的查找与替换
Dim myFind() As Variant, myReplace As String
Dim aArray As Variant, mySet As String, N As Integer, M As Integer
Dim myRange As Range
myFind = Array("A", "B", "C", "D", "Ａ", "Ｂ", "Ｃ", "Ｄ")
Application.ScreenUpdating = False
With Selection
'删除段落的首行缩进\左缩进和右缩进
With .ParagraphFormat
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LeftIndent = CentimetersToPoints(0)
.RightIndent = CentimetersToPoints(0)
.FirstLineIndent = CentimetersToPoints(0)
.TabStops.ClearAll '清除文档中所有制表位
.Space1 '单倍行距
End With
'设置字体字号
With .Font
.NameFarEast = "宋体"
.NameAscii = "Times New Roman"
.NameOther = "Times New Roman"
.Name = ""
.Size = 12
End With
'删除文档中所有非下划线的非英文后的一个或者多个全角\半角空格,包括段前空格\括号间空格
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([!a-zA-Z])[ ^t" & ChrW(160) & "]{1,}"
.MatchWildcards = True
.Wrap = wdFindStop
.Font.Underline = False
.Execute replacewith:="\1", Replace:=wdReplaceAll
End With
'将连续5个中文字符以上段落的行距设置为20磅固定行距,可视具体情况更改之
With .Find
.ClearFormatting
.Format = True
.Replacement.ClearFormatting
.Replacement.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
.Replacement.ParagraphFormat.LineSpacing = 20
.MatchWildcards = True
.Wrap = wdFindStop
.Text = "[一-龥]{5,}"
.Execute replacewith:="", Replace:=wdReplaceAll
End With
'以下查找与替换设置制表位,使选项对齐,此替换维持原有选项样式
With .Find
.ClearFormatting
With .Replacement
.ClearFormatting
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(0.74)
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(4.07)
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(7.41)
.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(10.74)
End With
.Text = "[A-DＡ-Ｄ][.、．]"
.Replacement.Text = "^t^&"
.Wrap = wdFindStop
.Format = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
'针对AB和CD选项为两个段落的情况,重设制表位(删除4.07)
Set myRange = Selection.Range
NR1: With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "A[.、．][!^13]@B[.、．][!^13]@^13^tC[.、．]*D[.、．]*^13"
.MatchWildcards = True
Do While .Execute
With myRange
.ParagraphFormat.TabStops.ClearAll
.ParagraphFormat.TabStops.Add CentimetersToPoints(0.74)
.ParagraphFormat.TabStops.Add CentimetersToPoints(7.41)
.SetRange .End, Selection.Range.End
GoTo NR1
End With
Loop
End With
'规避查找中的过于复杂的表达式
Set myRange = Selection.Range
NR2: With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Ａ[.、．][!^13]@Ｂ[.、．][!^13]@^13^tＣ[.、．]*Ｄ[.、．]*^13"
.MatchWildcards = True
Do While .Execute
With myRange
.ParagraphFormat.TabStops.ClearAll
.ParagraphFormat.TabStops.Add CentimetersToPoints(0.74)
.ParagraphFormat.TabStops.Add CentimetersToPoints(7.41)
.SetRange .End, Selection.Range.End
GoTo NR2
End With
Loop
End With
'进行中英文括号替换,中间加入一个制表符
With .Find
.ClearFormatting
.Replacement.ClearFormatting
' .Replacement.ParagraphFormat.TabStops.ClearAll
' .Replacement.Font.Spacing = 12
.MatchWildcards = True
'替换为带有两个全角空格的西文括号
' .Execute findtext:="[\(（][\)）]", replacewith:="(" & vbTab & ")", Replace:=wdReplaceAll
.Execute findtext:="[\(（][\)）]", replacewith:="( ) ", Replace:=wdReplaceAll
End With
'更改或者统一文档选项样式
mySet = VBA.InputBox(prompt:="请选择选项样式,1为'A.',2为'Ａ．',3为 'A、',单击取消退出替换!", Title:="选项样式设置", Default:=1)
Select Case mySet
Case ""
Exit Sub
Case 1
myReplace = ". " '"[A-D]."还一个半角空格,防止拼写检查错误
N = 64
Case 2
myReplace = "．" '"[Ａ-Ｄ]．"
N = -23616
Case 3
myReplace = "、" '"[A-D]、"
N = 64
Case Else
myReplace = aArray
If aArray = "[Ａ-Ｄ]．" Then
N = -23616
Else
N = 64
End If
End Select
For Each aArray In myFind
M = M + 1
If M = 5 Then M = 1
' Debug.Print VBA.Chr(M + N) & myReplace
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.Wrap = wdFindStop
.Execute findtext:=aArray & "[.、．]", replacewith:=VBA.Chr(M + N) & myReplace, Replace:=wdReplaceAll
End With
Next
End With
Application.ScreenUpdating = True
End Sub 
[此贴子已经被作者于2006-12-3 22:30:41编辑过] | 
楼主: tangqingfu
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-11-30 05:53
楼主
