Translate text using vba

Question

Probably could be a rare petition, but here is the issue.

I am adapting an excel of a third-party to my organization. The excel is developed in English and the peop

Answer 1

Update: Improved For Each v In arr_Response-iteration, allowing special charactors. Added mouse-cursor change, when translation is processing. Added an example on how to improve the translated output_string.

There are a majority of free translation API's outthere, but none really seems to beat Googles Translation Service, GTS (in my opinion). As a result of Googles' restrictions on the free GTS-usage, the best VBA-approach seems to be narrowed down to the IE.navigation - as Santosh's answer also emphasizes.

Using this approach, causes some problematics. The IE-instans doesn't know when the page is fully loaded, and IE.ReadyState is really not trusthworthy. Therefore the coder has to add "delays" using the Application.Wait function. When using this function, you are just guessing how long it would take, before the page is fully loaded. In situations where the internet is really slow, this hardcoded time, might not be enough. The following code fixes this, with the ImprovedReadyState.

In situations where a sheet has different columns, and you want to add different translation into every cell, I find the best approach where the translation-string is assigned to the ClipBoard, rather then calling a VBA-Function from within the formula. Thereby you can easily paste the translation, and modify it as a string.

How to use:

1. Insert the procedures into a custom VBA-Module
2. Change the 4 Const's to your desire (see upper TranslationText)
3. Assign a shortkey to fire the TranslationText-procedure

4. Activate the cell you want to translate. Required the first row to end with a language-tag. Etc. "_da", "_en", "_de". If you want another functionality, you change ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

5. Press the shortkey from 4. (etc. CTRL + SHIRT + S). See proces in your processbar (bottom of excel). Paste (CTRL+V) when translation done is displayed:

    Option Explicit

    'Description: Translates content, and put the translation into ClipBoard
    'Required References: MIS (Microsoft Internet Control)
    Sub TranslateText()

    'Change Const's to your desire
    Const INPUT_RANGE As String = "table_products[productname_da]"
    Const INPUT_LANG As String = "da"
    Const PROCESSBAR_INIT_TEXT As String = "Processing translation. Please wait... "
    Const PROCESSBAR_DONE_TEXT As String = "Translation done. "

    Dim ws_ActiveWS As Worksheet
    Dim r_ActiveCell As Range, r_InputRange As Range
    Dim s_InputStr As String, s_InputLang As String, s_OutputLang As String, arr_Response() As String, s_Translation As String
    Dim o_IE As Object, o_MSForms_DataObject As Object
    Dim i As Long
    Dim v As Variant

    Set o_MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set ws_ActiveWS = ThisWorkbook.ActiveSheet
    Set r_ActiveCell = ActiveCell
    Set o_IE = CreateObject("InternetExplorer.Application")
    Set r_InputRange = ws_ActiveWS.Range(INPUT_RANGE)

    'Update statusbar ("Processing translation"), and change cursor
    Application.Statusbar = PROCESSBAR_INIT_TEXT
    Application.Cursor = xlWait

    'Declare inputstring (The string you want to translate from)
    s_InputStr = ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

    'Find the output-language
    s_OutputLang = Right(ws_ActiveWS.Cells(1, r_ActiveCell.Column).Value, 2)

    'Navigate to translate.google.com
    With o_IE

        .Visible = False 'Run IE in background
        .Navigate "http://translate.google.com/#" & INPUT_LANG & "/" _
            & s_OutputLang & "/" & s_InputStr

        'Call improved IE.ReadyState
        Do
            ImprovedReadyState
        Loop Until Not .Busy

        'Split the responseText from Google
        arr_Response = Split(.Document.getElementById("result_box").innerHTML, "", "")
            s_Translation = Replace(s_Translation, "", "")
            s_Translation = Replace(s_Translation, """", "")
            s_Translation = Replace(s_Translation, "=hps>", "")
            s_Translation = Replace(s_Translation, "=atn>", "")
            s_Translation = Replace(s_Translation, "=hps atn>", "")

            'Improve translation.
            'This could etc. be moved to seperate sheets (containing every language), and make the lookup in a dynamic table/sheet. Futurely it'd be possible to hook on the changeevent, and automatically improve the translation-algoritmen.
            'If Google can't translate the etc. the word "Lys", you can extend the translation, with an auto correction. This example shows to autocorrect the word "Lys" -> "ljus". 
            If (s_OutputLang = "sv") Then
                s_Translation = Replace(s_Translation, "lys", "ljus")
            End if
        Next v

        'Put Translation into Clipboard
        o_MSForms_DataObject.SetText s_Translation
        o_MSForms_DataObject.PutInClipboard

        If (s_Translation <> vbNullString) Then
            'Put Translation into Clipboard
            o_MSForms_DataObject.SetText s_Translation
            o_MSForms_DataObject.PutInClipboard

            'Update statusbar ("Translation done"). If the input_string is above 70 chars (which is roughly the limitation in processbar), then cut the string, and extend with "...".
            Application.Statusbar = PROCESSBAR_DONE_TEXT & """" & IIf(Len(s_InputStr) < 70, s_InputStr, Mid(s_InputStr, 1, 70) & "...") & """"
        Else
            'Update statusbar ("Error")
            Application.Statusbar = PROCESSBAR_ERROR_TEXT
        End If

        'Cleanup
        .Quit

        'Change cursor back to default
        Application.Cursor = xlDefault

        Set o_MSForms_DataObject = Nothing
        Set ws_ActiveWS = Nothing
        Set r_ActiveCell = Nothing
        Set o_IE = Nothing

    End With

End Sub

Sub ImprovedReadyState()

    Dim si_PauseTime As Single: si_PauseTime = 1 'Set duration
    Dim si_Start As Single: si_Start = Timer 'Set start-time
    Dim si_Finish As Single 'Set end-time
    Dim si_TotalTime As Single 'Calculate total time.

    Do While Timer < (si_Start + si_PauseTime)
        DoEvents
    Loop

    si_Finish = Timer

    si_TotalTime = (si_Finish - si_Start)

End Sub