在excel中建立按鈕,雙擊後輸入下列代碼:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False '關閉屏幕刷新
On Error Resume Next '捕捉錯誤
Dim oSt As Range, wdDoc As Word.Document, wdRange As Word.Range
myPath = ThisWorkbook.Path & "\2.doc" '定義word文件路徑,名字自己修改,我設定為2.doc
Set wdDoc = GetObject(myPath) '打開word
Dim key(2) '定義壹下數組,
key(1) = "abcdefg" '要替換的數據
key(2) = "hijklmn"
Set wdRange = wdDoc.Content '將word的文檔內容賦予wdrange
For i = 1 To 2 '循環
With wdRange.Find
.Text = key(i) '查找
.Replacement.Text = key(i) & IIf(i = 1, Cells(1, 1).Value, Cells(5, 2).Value) '替換
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wdRange.Find.Execute Replace:=wdReplaceAll '全部替換
Next
wdDoc.Save '保存word
wdDoc.Close '關閉word
Set wdDoc = Nothing
Application.ScreenUpdating = True '開啟屏幕刷新
End Sub
經測試,已經達到樓主要求,請追加分數並采納.呵呵