【WPS】【WORD&EXCEL】【VB】实现微软WORD自动更正的效果

1. 代码规范方面

添加 Option Explicit：强制要求显式声明所有变量，这样可以避免因变量名拼写错误等情况而出现难以排查的逻辑错误，提高代码的健壮性。
使用 On Error GoTo 进行错误处理 ：通过设置错误处理机制，当代码执行过程中出现错误时，能够跳转到指定的错误处理代码段（ErrorHandler 标签处），在那里可以进行合适的处理，比如弹出错误提示消息框告知用户错误信息，同时尽量释放已经占用的资源（如关闭 Excel 相关对象），避免因错误导致程序异常退出而留下资源占用等问题。

2. 查找替换操作细化方面

使用 With 语句设置 Find 对象属性 ：在进行查找替换操作时，使用 With 语句可以更简洁清晰地对 Find 对象的多个属性进行设置，包括设置查找文本（.Text）、替换文本（.Replacement.Text）以及其他如查找方向（.Forward）、超出范围处理方式（.Wrap）、是否查找格式（.Format）以及匹配相关的属性（.MatchCase、.MatchWholeWord、.MatchWildcards 等）。这样代码结构更加清晰，便于理解和后续维护，同时可以方便地根据实际需求调整这些查找替换的具体规则。

vbnet 复制代码

Option Explicit '强制要求显式声明变量，避免因变量名拼写错误等导致的潜在问题

Sub ReplaceWithExcelData()
    '定义常量，确保替换方式常量正确定义
    Const wdReplaceAll = 2
    Const wdMatchCase = False '设置查找时不区分大小写，可根据实际需求调整
    Const wdMatchWholeWord = False '设置不要求全字匹配，可根据实际需求调整
    Const wdMatchWildcards = False '设置不使用通配符匹配，可根据实际需求调整
    
    Dim xlApp As Object
    Dim xlBook As Object
    Dim xlSheet As Object
    Dim wordRange As Range
    Dim i As Long
    Dim findText As String
    Dim replaceText As String
    
    On Error GoTo ErrorHandler '设置错误处理，当出现错误时跳转到ErrorHandler标签处执行错误处理代码
    
    '创建Excel应用程序对象并打开工作簿
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False '设置Excel不可见，可根据需求调整为True查看Excel操作情况
    Set xlBook = xlApp.Workbooks.Open(ThisDocument.Path & "\1.xlsx") '根据实际路径调整，这里假设同文件夹
    Set xlSheet = xlBook.Sheets(1) '假设数据在第一个工作表，如果不是需修改索引
    
    Set wordRange = ActiveDocument.Content '针对整个文档内容进行查找替换操作，可按需修改范围，比如仅针对选中部分等
    
    For i = 1 To 1000 '假设你的数据范围是A1:B10，共10行，如果实际更多或更少要相应修改
        findText = Trim(xlSheet.Cells(i, 1).Value) '去除两端空格
        replaceText = Trim(xlSheet.Cells(i, 2).Value)
        
        With wordRange.Find '使用With语句简化对Find对象属性的设置
           .Text = findText
           .Replacement.Text = replaceText
           .Forward = True '设置查找方向为向前，一般默认也是向前，可根据需求调整
           .Wrap = wdFindContinue '设置查找范围超出文档末尾时的处理方式
           .Format = False '不查找格式，只查找文本内容，可根据需求调整
           .MatchCase = wdMatchCase '应用不区分大小写的设置
           .MatchWholeWord = wdMatchWholeWord '应用不要求全字匹配的设置
           .MatchWildcards = wdMatchWildcards '应用不使用通配符匹配的设置
           .Execute Replace:=wdReplaceAll
        End With
    Next i
    
    '正常执行完后关闭Excel相关对象释放资源
    xlBook.Close SaveChanges:=False '关闭Excel文件，不保存更改（如果需要保存更改可设为True）
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub '正常退出程序，避免进入错误处理代码块后继续执行后面的代码
    
ErrorHandler:
    MsgBox "程序出现错误，错误信息：" & Err.Description, vbCritical '弹出错误消息框显示错误信息
    '如果出现错误，也要尽量关闭Excel相关对象释放资源，避免资源占用
    On Error Resume Next '忽略下面代码可能出现的错误，确保资源释放代码执行
    xlBook.Close SaveChanges:=False
    xlApp.Quit
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    On Error GoTo 0 '恢复正常的错误处理机制
End Sub

3. 测试

1.xlsx文件如下：
2-副本.docm文件如下：