|
使用场合：同时进行多个查找与替换，支持非通配符下的特殊字符的替换。 比如，适用于ISO文件，因组织机构调整，对所有原有部门一次输入后替换为新部门。 查找的各个内容之间，用英文逗号分隔（","），查找数量不限。 替换的各个内容之间，用英文逗号分隔（","），替换数量必须等同于查找数量，如是删除某个查找内容，替换中键入""(空空) 以下代码供参考： '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-2-2 14:54:39
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 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
'----------------------
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-2-2 14:54:59
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [用户窗体-UserForm1]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ 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
'----------------------
存在问题： 可能对于多分节文档中（超过二节）的页眉页脚和脚注、尾注等的非同前文字部分，会替换不到。 有空我再做一个集中替换，即对某个文件夹中的所有文件进行一次性替换。 请大家多提意见以便修改。
rH7z06UW.zip
(17.97 KB, 下载次数: 517)
[此贴子已经被konggs于2006-8-23 17:44:38编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-2-2 15:01
楼主
