Function WordReplace(FileName As String, SearchString2() As String, ReplaceString2() As String, k As Integer, _
                     Optional SaveFile As String = "", Optional MatchCase As Boolean = False) As Integer
On Error GoTo ErrorMsg '函数运行时发生遇外或错误,转向错误提示信息

Dim WordApp As New Word.Application
Dim wordDoc As New Word.Document
Dim wordArange As Word.Range
Dim wordSelection As Word.Selection
Dim ReplaceSign As Boolean
Dim i As Integer
Dim tt As Integer
Dim SearchString As String
Dim ReplaceString As String

'判断将要替换的文件是否存在
If Dir(FileName) = "" Then
'替换文件不存在
MsgBox "未找到" & FileName & "文件" '提示替换文件不存在信息
WordReplace = -2 '返回替换文件不存在的值
Exit Function '退出函数
End If

Set WordApp = CreateObject("Word.Application") '建立WORD实例
WordApp.Visible = False '屏蔽WORD实例窗体
Set wordDoc = WordApp.Documents.Open(FileName) '打开文件并赋予文件实例
Set wordSelection = WordApp.Selection '定位文件实例
Set wordArange = WordApp.ActiveDocument.Range(0, 1) '指定文件编辑位置
wordArange.Select '激活编辑位置

i = 0 '初始化替换次数值
ReplaceSign = True '初始化是否替换成功标志
For tt = 0 To k
    SearchString = SearchString2(tt)
    ReplaceString = ReplaceString2(tt)
    ReplaceSign = True
    Do While ReplaceSign
       ReplaceSign = wordArange.Find.Execute(SearchString, MatchCase, , , , , , wdFindContinue, , ReplaceString, True) '查找并替换
       '判断查找并替换是否成功,如果成功替换次数值递增1
        If ReplaceSign = True Then
           i = i + 1
        End If
    Loop
Next

WordApp.Visible = True


'如果替换成功，则提示是否保存
If i > 0 Then
'判断是否需要另存
   If Trim(SaveFile) <> "" Then
'需要另存
      If Dir(SaveFile) = "" Then
         wordDoc.SaveAs SaveFile '文件另存为……
      Else
'咨询是否替换文件,如果不替换则放弃本次操作,否则存在本次操作
        If MsgBox("是否替换" & SaveFile & "文件？", vbYesNo + vbQuestion, "替换") = vbYes Then
           wordDoc.SaveAs SaveFile '文件另存为……
        End If
      End If
   Else
     If MsgBox("是否保存对" & SaveFile & "更改？", vbYesNo + vbQuestion, "保存") = vbYes Then
        wordDoc.Save '保存在原文件中
     End If
  End If
End If

WordReplace = i '返回替换次数

wordDoc.Close '关闭文档实例
WordApp.Quit '关闭WORD实例
Set wordDoc = Nothing '清除文件实例
Set WordApp = Nothing '清除WORD实例


Exit Function


ErrorMsg:
MsgBox Err.Number & ":" & Err.Description '提示错误信息
WordReplace = -1 '返回错误信息值
wordDoc.Close '关闭文档实例
WordApp.Quit '关闭WORD实例
Set wordDoc = Nothing '清除文件实例
Set WordApp = Nothing '清除WORD实例

End Function

初步看了一下好像没有什么问题，而且你的报错比较奇怪，没有遇到过。
请说明你报错时候运行到哪一行，报错窗口截图。

运行后，只要一调用这个函数，立即弹出这个

估计是.Find.Execute出错，我试着简化成下面这样，还是会出上面那个错误，求解决方案

Dim WordApp As New Word.Application
Dim wordDoc As New Word.Document
Dim wordArange As Word.Range
Dim wordSelection As Word.Selection

Set WordApp = CreateObject("Word.Application") '建立WORD实例
WordApp.Visible = True '屏蔽WORD实例窗体
Set wordDoc = WordApp.Documents.Open(App.Path & "\Files\检查笔录.docx") '打开文件并赋予文件实例
Set wordSelection = WordApp.Selection '定位文件实例
Set wordArange = WordApp.ActiveDocument.Range(0, 1) '指定文件编辑位置
wordArange.Select '激活编辑位置

 wordArange.Find.Execute FindText:="YYYY", ReplaceWith:=Text28.Text, Replace:=wdReplaceAll

没有出现中断？估计是软件本身的问题。
你可以在Set WordApp = CreateObject("Word.Application") 这行加一个中断点，然后F8逐行运行试试

是这行的问题
wordArange.Find.Execute FindText:="YYYY", ReplaceWith:=Text28.Text, Replace:=wdReplaceAll

我试着用立即窗口运行
.Find.Execute  也是要求关闭VB

我已重装了一次VB ，怎么破？请指教

试试on error resume next，或者用这语句排查出错误原因先：
on error go to err1
err1:exit sub

你的代码，可能引用的时候早已经出错了吧

事实证明，你的这段程序是可以执行的。我已验证。至于你运行不起来的原因：要么你VB装的有问题，缺少了什么，要么就是你没有引用正确的work library，自己检查一下咯

话说回来，你这个function感觉还蛮好用的。收了哈。