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.
![Columns in Excel]()
How to use:
- Insert the procedures into a custom VBA-Module
- Change the 4 Const's to your desire (see upper
TranslationText)
- Assign a shortkey to fire the
TranslationText-procedure
![Shortkey Excel]()
- 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)
![enter image description here]()
- 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:
![enter image description here]()
![Translation done]()
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, "<span class")
'Remove html from response, and construct full-translation-string
For Each v In arr_Response
s_Translation = s_Translation & Replace(v, "<span>", "")
s_Translation = Replace(s_Translation, "</span>", "")
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
