|
Sub 查找替换()
Application.ScreenUpdating = False '关闭屏幕刷新
Cells.Font.ColorIndex = 0 '取消所有字颜色
Rows(ActiveCell.Row & "").Font.ColorIndex = 3 '当前行字为红色
Dim WDAPP As Word.Application
Dim SourceFile, DestinationFile
SourceFile = ThisWorkbook.Path & "\0.doc" ' 指定源文件名。可以包含目录或文件夹、以及驱动器。
DestinationFile = ThisWorkbook.Path & "\1.doc" ' 指定目的文件名。可以包含目录或文件夹、以及驱动器。
FileCopy SourceFile, DestinationFile ' 将源文件的内容复制成目的文件。
Set WDAPP = New Word.Application
With WDAPP
.Visible = True '可见
.Documents.Open (DestinationFile) '打开word
With .Application.Selection
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
For i = 1 To 6
With .Find
s = "共同信守"
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
t = .Execute(FindText:=s)
p = .Information(wdActiveEndPageNumber) '这个句子出错,不知怎么修改能在Excel中运行?
r = .Information(wdFirstCharacterLineNumber) '这个句子出错,不知怎么修改能在Excel中运行?
'出错提示:"方法和数据成员未找到"
If t Then
MsgBox "成功,已找到“" & s & "”" & vbCrLf & _
"页码:" & p & vbCrLf & "行数:" & r, vbOKOnly, "成功"
Else
MsgBox "很遗憾,没有找到“" & s & "”", vbOKOnly, "遗憾"
End If
.Text = Cells(1, i).Value '要查找的内容
.Replacement.Text = Cells(ActiveCell.Row, i).Value '要替换的内容(当前行)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
.Find.Execute Replace:=wdReplaceAll '替换
Next i
End With
.ActiveDocument.Save '保存文件
.Quit '关闭文件
End With
Set WDAPP = Nothing
Range("A" & ActiveCell.Row).Copy
End Sub
|
|