|
Sub 替换word()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application") '新建Word对象
Dim wdd
t = Timer
Dim ar As Variant
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "衡柳线下行K12+418三角坑整治方案-序号.docx")
If f = "" Then MsgBox "找不到衡柳线下行K12+418三角坑整治方案-序号.docx": End
FileCopy lj & f, lj & "衡柳线下行K12+418三角坑整治方案" & Format(Date, "yyyy年m月d日") & ".docx"
ar = ActiveSheet.[a1].CurrentRegion
wdApp.Visible = True
Set wdd = wdApp.Documents.Open(lj & "\衡柳线下行K12+418三角坑整治方案" & Format(Date, "yyyy年m月d日") & ".docx")
For i = 2 To UBound(ar)
If Len(Trim(ar(i, 2))) > 0 Then
With wdApp.Selection
.HomeKey unit:=6 '光标置于文件首
If .Find.Execute(ar(i, 1) & "@") Then '查找到指定字符串
.Font.Color = wdColorAutomatic '字符为自动颜色
.Text = ar(i, 2) '替换字符串
End If
End With
End If
Next i
wdd.Close True
wdApp.Quit
Set wdd = Nothing
Set wdApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "耗时:" & Format(Timer - t, "0.00") & "秒"
End Sub
|
|