查找与替换的基本代码用法之三(批量替换) (VBA)

功能简介：同时进行多个查找与替换，支持非通配符下的特殊字符的替换。
比如，适用于 ISO 文件，因组织机构调整，对所有原有部门一次输入后替换为新部门。
查找的各个内容之间，用英文逗号分隔（","），查找数量不限。
替换的各个内容之间，用英文逗号分隔（","），替换数量必须等同于查找数量，如是删除某
个查找内容，替换中键入""(空空)

Private Sub Document_Close()
On Error Resume Next
Application.CommandBars("Edit").Controls("多个替换").Delete    '恢复原有菜单
End Sub
'----------------------
Private Sub Document_Open()
On Error Resume Next
Dim NewButton As CommandBarButton
CustomizationContext = ActiveDocument    '将自定义组合键和工具命令保存于
活动文档中
'指定 CTRL+F为键盘快捷方式
KeyBindings.Add wdKeyCategoryMacro, "MySub", BuildKeyCode(wdKeyControl,
wdKeyF)
'指定 F5 为快捷方式
KeyBindings.Add wdKeyCategoryMacro, "MySub", BuildKeyCode(wdKeyF5)
Application.CommandBars("Edit").Controls("多个替换").Delete    '预防性删除
Set NewButton =
Application.CommandBars("Edit").Controls.Add(Type:=msoControlButton, Before:=11)
With NewButton
.Caption = "多个替换"    '命令名称
.FaceId = 100    '命令的 FaceId
.Visible = True    '可见
.OnAction = "MySub"    '指定响应过程名
End With
End Sub
'----------------------
Sub MySub()
UserForm1.Show
End Sub
'----------------------
Sub ComReset()   '恢复默认设置
Application.CommandBars("Edit").Reset
End Sub
Private Sub CommandButton1_Click()
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox1.SetFocus
End Sub
'----------------------
Private Sub CommandButton2_Click()
Dim MyFind() As String, MyRep() As String, i As Integer, aStory As Variant
On Error Resume Next
'检查是否为空
If Me.TextBox1 = "" And Me.TextBox2 = "" Then Exit Sub
'定义两个数组,以","分隔
MyFind = Split(Me.TextBox1, ",")
MyRep = Split(Me.TextBox2, ",")
If UBound(MyRep) <> UBound(MyFind) Then
'如果两个文本框的分隔数目不一致,提示
MsgBox "替换的数目与查找数目不一致!", vbExclamation + vbOKOnly,
"Warnning"
Me.TextBox2.SetFocus
Exit Sub
End If
Application.ScreenUpdating = False
With ActiveDocument
For i = 0 To UBound(MyFind)    '一个从下标为 0 的循环替换
For Each aStory In .StoryRanges    '在文档的各个文字部分
'如果是"",则相当于删除原查找内容
aStory.Find.Execute findtext:=MyFind(i), _
replacewith:=VBA.IIf(MyRep(i) = """""", "",
MyRep(i)), Replace:=2
'如果有下一节中相同内容文字部分,也进行替换
If Not aStory.NextStoryRange Is Nothing Then _
aStory.NextStoryRange.Find.Execute findtext:=MyFind(i), _
replacewith:=VBA.IIf(MyRep(i)  =  """""",  "",  MyRep(i)),
Replace:=2
Next
Next
End With
Application.ScreenUpdating = True

Unload Me    '卸载窗体
End Sub
'----------------------
Private Sub UserForm_Initialize()
Me.Caption = "多文本替换操作"
Me.TextBox1.SetFocus
Me.CommandButton2.Default = True
End Sub