MS Word VBA: How to replace each word with its translation while keeping formatting

Question

I have a word document and want to replace each single word with its translation while keeping all the formatting intact. I cannot use "Find And Replace" dialog because I am not trying replace a particular set of words but I am replacing all the words. How do I do that using VBA?

Update I am using Word 2010. So far, I can loop through the words using ActiveDocument.Range.Words property but I don't know how to replace those words with its translation? While replacing, I want to keep all the formattings like font name, size, color, background color, underline, bold in short all the formatting options as it is.

You need to provide more details in order to get any useful answers, please see the FAQ. What version of Word are you using? What have you tried so far? Any code samples? Etc. — Olle Sjögren
If you loop through ActiveDocument.Range.Words you can replace the words one at a time; note however that if you do so, each word will take on the formatting of the first character of the word. If the word has varied formatting within it (e.g. the last letter of the word is underlined), then that formatting will be lost. — Avi Shmidman

ZolVas ZolVas · Accepted Answer · 2016-02-22T16:04:20

I guess you have an array of words ("apple", "book", "cat") and the array of their translation ("pomme", "livre", "chat").

Your goal is to bulk change words one by one.

So you need a loop. Here is the loop that may help (if I understand your problem correctly).

Bulk change upon two arrays:

Option Explicit
Sub replaceArrayForArray()
'
'to create array use prefix\suffix and replacing tool http://textmechanic.com/
'
'
findArray = Array("apple", "book", "cat")
replArray = Array("pomme", "livre", "chat")

For i = 0 To UBound(findArray)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = findArray(i)
        .Replacement.Text = replArray(i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute replace:=wdReplaceAll
Next i
End Sub

The more diffucult issue could have been if you worked with figures and you had to bulk change figures without overlap. The method with the use of the same macro more or less described here: MS Word Macro to increment all numbers in word document.

MS Word VBA: How to replace each word with its translation while keeping formatting

1 Answers