使用 Excel 电子表格查找和替换 Microsoft Word 中的文本

Question

我有一份用英文写的Word文档。英文缩写词需要翻译成法文。 我还有一个 Excel 电子表格。 Sheet1 在 A 列中包含英文缩写词，在 B 列中包含法文缩写词。

我需要一个 VBA 脚本来查看我的 Word 文档并将所有英语缩写词替换为法语缩写词。我没有 VBA 经验，所以我不知道从哪里开始。我已经在 Word 和 Excel 中启用了 VBA。我应该在 Word 还是 Excel 的模块中编写 VBA 脚本吗？有人可以粘贴一个代码让我复制，以便我知道该怎么做吗？

非常非常感谢！

我尝试了网上看到的几个脚本，但没有成功。

Answer 1

我已经有一段时间没有使用 VBA 了，但几年前我曾在该领域工作过。如果我理解这里的问题，下面的代码可能对您有用。

Sub TranslateAcronyms()
    Dim wordApp As Object
    Dim doc As Object
    Dim rng As Object
    Dim excelApp As Object
    Dim ws As Object
    Dim lastRow As Long
    Dim i As Long
    
    ' Create an instance of Word application
    Set wordApp = CreateObject("Word.Application")
    wordApp.Visible = False ' Set to True if you want to see the Word application
    
    ' Open the Word document
    Set doc = wordApp.Documents.Open("C:\Path\To\Your\Word\Document.docx")
    
    ' Create an instance of Excel application
    Set excelApp = CreateObject("Excel.Application")
    excelApp.Visible = False ' Set to True if you want to see the Excel application
    
    ' Open the Excel workbook
    Set ws = excelApp.Workbooks.Open("C:\Path\To\Your\Excel\Workbook.xlsx").Sheets("Sheet1")
    
    ' Get the last row in column A of Excel sheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row ' -4162 represents xlUp
    
    ' Loop through each cell in column A of Excel
    For i = 1 To lastRow
        ' Get the English acronym from Excel
        Dim englishAcronym As String
        englishAcronym = ws.Cells(i, 1).Value
        
        ' Find and replace the English acronym with the French acronym in Word document
        Set rng = doc.Content
        With rng.Find
            .Text = englishAcronym
            .Replacement.Text = ws.Cells(i, 2).Value ' French acronym from column B
            .Wrap = 1 ' wdFindContinue
            .Execute Replace:=2 ' wdReplaceAll
        End With
    Next i
    
    ' Close the Word document and Excel workbook
    doc.Close True ' Save changes
    excelApp.Quit
    
    ' Release the objects
    Set doc = Nothing
    Set wordApp = Nothing
    Set ws = Nothing
    Set excelApp = Nothing
    
    MsgBox "Acronyms translated successfully!"
End Sub

尝试一下，然后给我反馈。