CODEWITHSUNDEEP
excelvbareplacems-wordfind
Bianca D'Aoust
Bianca D'Aoust

Reputation: 1

Find and replace text in Microsoft Word using an Excel spreadsheet

I have a Word document written in English. The English acronyms need to be translated to French. I also have an Excel spreadsheet. Sheet1 has the English acronyms in column A, and the French acronyms in column B.

I need a VBA script that will look into my Word document and replace all of the English acronyms to French acronyms. I'm not experienced in VBA so I don't know where to start. I have enabled VBA in both Word and Excel. Should I write the VBA script in a module in Word or Excel? Could someone paste a code for me to copy so that I have an idea of what to do?

Thank you very very much!

I tried several scripts that I've seen online, without any success.

Upvotes: 0

Views: 220

Answers (1)

ASH
ASH

Reputation: 20322

I haven't used VBA in a while, but I used to work in that space a few years ago. If I understand the ask here, the code below may be useful for you.

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

Try that, and give me feedback.

Upvotes: 0

Related Questions