Google Translate Macro Function - How to rafear to Cell and/or Text in Quotes?

DrHacker

New Member
Joined
Jun 4, 2018
Messages
33
Hello experts, i modify actual script to create a function in Excel to translate from Google Translator with formula.

In order to work, you need to add Reference "Microsoft Internet Controls" (Tools>References)

I create it referring to a cell range value with syntax =GoogleTranslate(A1,”en”,”es”)

Is there a way to use, as well, Cell Range and/or Quoted Text? I mean, both with same formula function. I mean, use any of these two ways of syntax:

=GoogleTranslate(A1,”en”,”es”)

OR

=GoogleTranslate(“Specific Text in Quotes”,”en”,”es”)


Here is the VBA code for this function (Add as Module):

VBA Code:
'***Google Translation Custom Function START ***

'Google Language Codes List:

    'Auto Detect = 0   Bulgarian = bg    Finnish = fi         Hungarian = hu    Latvian = lv        Russian = ru      Turkish = tr
'English = en Catalan = ca French = fr Icelandic = is Lithuanian = lt Serbian = sr Ukrainian = uk
'Afrikaans = af Chinese = zh Galician = gl Indonesian = id Macedonian = mk Slovak = sk Urdu = ur
'Albanian = sq Croatian = hr Georgian = ka Irish = ga Malay = ms Slovenian = sl Vietnamese = vi
'Arabic = ar Czech = cs German = de Italian = it Maltese = mt Spanish = es Welsh = cy
'Armenian = hy Danish = da Greek = el Japanese = ja Norwegian = no Swahili = sw Yiddish = yi
'Azerbaijani = az Dutch = nl Gujarati = gu Kannada = kn Persian = fa Swedish = sv
'Basque = eu Esperanto = eo Haitian_Creole = ht Korean = ko Polish = pl Tamil = ta
'Belarusian = be Estonian = et Hebrew = iw Lao = lo Portuguese = pt-PT Telugu = te
    'Bengali = bn      Filipino = tl     Hindi = hi           Latin = la        Romanian = ro       Thai = th

    Function ConvertToGet(val As String)

val = Replace(val, " ", "+")
val = Replace(val, vbNewLine, "+")
val = Replace(val, "(", "%28")
val = Replace(val, ")", "%29")
ConvertToGet = val

End Function

Function Clean(val As String)

val = Replace(val, """, """")
val = Replace(val, "%2C", ",")
val = Replace(val, "'", "'")
Clean = val

End Function
Public Function RegexExecute(str As String, reg As String, Optional matchIndex As Long, Optional subMatchIndex As Long) As String

        Dim RegEx, match, Matches

        On Error GoTo ErrorHandler

Set RegEx = CreateObject("VBScript.RegExp"): RegEx.Pattern = reg
RegEx.Global = Not (matchIndex = 0 And subMatchIndex = 0)
If RegEx.Test(str) Then

Set Matches = RegEx.Execute(str)
RegexExecute = Matches(matchIndex).SubMatches(subMatchIndex)
Exit Function

End If

ErrorHandler:

RegexExecute = CVErr(xlErrValue)

End Function

Public Function GoogleTranslate(rng As Range, Optional translateFrom As String = "en", Optional translateTo As String = "es")

Dim getParam As String, trans As String, objHTTP As Object, URL As String

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

getParam = ConvertToGet(rng.Value)

URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam

objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")

If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
GoogleTranslate = Clean(trans)

Else

GoogleTranslate = CVErr(xlErrValue)

End If

End Function

Sub RegisterGoogleTranslatorFunction()

Dim strFunc As String 'name of the function you want to register
Dim strDesc As String 'description of the function itself
Dim strArgs() As String 'description of function arguments

ReDim strArgs(1 To 3) 'The upper bound is the number of arguments in your function
strFunc = "GoogleTranslate"
strDesc = "Google Translator Custom function: " & vbNewLine & vbNewLine & _
"Formula Syntaxis =TRANSLATE(''A1'',''en'',''es'')" & vbNewLine & _
"To autodetect language use 0. Instead of ''en''" & vbNewLine & vbNewLine & _
"For additional languages visit: https://cloud.google.com/translate/docs/languages/"

strArgs(1) = "Select Cell value to Translate"
strArgs(2) = "Tranlate FROM Language"
strArgs(3) = "Tranlate TO Language"

Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"

    End Sub

'***Google Translation Custom Function FINISH ***
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Just change the rng As Range parameter to a String data type and rng.Value to the string variable.
 
Upvote 0
It Works! Thanks :)

Updated code, if some one needs.

VBA Code:
'***Google Translation Custom Function START ***

'Google Language Codes List:

    'Auto Detect = 0   Bulgarian = bg    Finnish = fi         Hungarian = hu    Latvian = lv        Russian = ru      Turkish = tr
'English = en Catalan = ca French = fr Icelandic = is Lithuanian = lt Serbian = sr Ukrainian = uk
'Afrikaans = af Chinese = zh Galician = gl Indonesian = id Macedonian = mk Slovak = sk Urdu = ur
'Albanian = sq Croatian = hr Georgian = ka Irish = ga Malay = ms Slovenian = sl Vietnamese = vi
'Arabic = ar Czech = cs German = de Italian = it Maltese = mt Spanish = es Welsh = cy
'Armenian = hy Danish = da Greek = el Japanese = ja Norwegian = no Swahili = sw Yiddish = yi
'Azerbaijani = az Dutch = nl Gujarati = gu Kannada = kn Persian = fa Swedish = sv
'Basque = eu Esperanto = eo Haitian_Creole = ht Korean = ko Polish = pl Tamil = ta
'Belarusian = be Estonian = et Hebrew = iw Lao = lo Portuguese = pt-PT Telugu = te
    'Bengali = bn      Filipino = tl     Hindi = hi           Latin = la        Romanian = ro       Thai = th

    Function ConvertToGet(val As String)

val = Replace(val, " ", "+")
val = Replace(val, vbNewLine, "+")
val = Replace(val, "(", "%28")
val = Replace(val, ")", "%29")
ConvertToGet = val

End Function

Function Clean(val As String)

val = Replace(val, "&quot;", """")
val = Replace(val, "%2C", ",")
val = Replace(val, "&#39;", "'")
Clean = val

End Function
Public Function RegexExecute(str As String, reg As String, Optional matchIndex As Long, Optional subMatchIndex As Long) As String

        Dim RegEx, match, Matches

        On Error GoTo ErrorHandler

Set RegEx = CreateObject("VBScript.RegExp"): RegEx.Pattern = reg
RegEx.Global = Not (matchIndex = 0 And subMatchIndex = 0)
If RegEx.Test(str) Then

Set Matches = RegEx.Execute(str)
RegexExecute = Matches(matchIndex).SubMatches(subMatchIndex)
Exit Function

End If

ErrorHandler:

RegexExecute = CVErr(xlErrValue)

End Function

Public Function GoogleTranslate(rng As String, Optional translateFrom As String = "en", Optional translateTo As String = "es")

Dim getParam As String, trans As String, objHTTP As Object, URL As String

Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

getParam = ConvertToGet(rng)

URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam

objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.Send ("")

If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
GoogleTranslate = Clean(trans)

Else

GoogleTranslate = CVErr(xlErrValue)

End If

End Function

Sub RegisterGoogleTranslatorFunction()

Dim strFunc As String 'name of the function you want to register
Dim strDesc As String 'description of the function itself
Dim strArgs() As String 'description of function arguments

ReDim strArgs(1 To 3) 'The upper bound is the number of arguments in your function
strFunc = "GoogleTranslate"
strDesc = "Google Translator Custom function: " & vbNewLine & vbNewLine & _
"Formula Syntaxis =TRANSLATE(''A1'',''en'',''es'')" & vbNewLine & _
"To autodetect language use 0. Instead of ''en''" & vbNewLine & vbNewLine & _
"For additional languages visit: https://cloud.google.com/translate/docs/languages/"

strArgs(1) = "Select Cell value to Translate"
strArgs(2) = "Tranlate FROM Language"
strArgs(3) = "Tranlate TO Language"

Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"

    End Sub

'***Google Translation Custom Function FINISH ***


[CODE=vba]
 
Upvote 0
Dears,

thank you for sharing your experience
i'm trying to implement this vba function to translate cells, however, there is no way to let this function works.
when i digit in a cell "=GoogleTranslate("lion","en","it")" or "=GoogleTranslate(A2,"en","it")" it just say that "the formula contains an error"

has anyone had similar experience? can you help me?
(i followed the instructions, adding "microsoft internet control" to the references)
i'm stuck cause i've tried many VBA formula like this, found on web, with no results

thank you in advance for your support!

Tommaso
 
Upvote 0
Welcome to MrExcel forums.

I don't know if this will fix your "the formula contains an error" issue, but the GoogleTranslate UDF doesn't work because the HTML has changed since the OP posted the code.

Here is the code updated to extract the translated words from the current HTML.

VBA Code:
Option Explicit

'***Google Translation Custom Function START ***

'Google Language Codes List:

'Auto Detect = 0   Bulgarian = bg    Finnish = fi         Hungarian = hu    Latvian = lv        Russian = ru      Turkish = tr
'English = en Catalan = ca French = fr Icelandic = is Lithuanian = lt Serbian = sr Ukrainian = uk
'Afrikaans = af Chinese = zh Galician = gl Indonesian = id Macedonian = mk Slovak = sk Urdu = ur
'Albanian = sq Croatian = hr Georgian = ka Irish = ga Malay = ms Slovenian = sl Vietnamese = vi
'Arabic = ar Czech = cs German = de Italian = it Maltese = mt Spanish = es Welsh = cy
'Armenian = hy Danish = da Greek = el Japanese = ja Norwegian = no Swahili = sw Yiddish = yi
'Azerbaijani = az Dutch = nl Gujarati = gu Kannada = kn Persian = fa Swedish = sv
'Basque = eu Esperanto = eo Haitian_Creole = ht Korean = ko Polish = pl Tamil = ta
'Belarusian = be Estonian = et Hebrew = iw Lao = lo Portuguese = pt-PT Telugu = te
'Bengali = bn      Filipino = tl     Hindi = hi           Latin = la        Romanian = ro       Thai = th

Public Function GoogleTranslate(rng As String, Optional translateFrom As String = "en", Optional translateTo As String = "es")

    Dim getParam As String, objHTTP As Object, URL As String
    
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    getParam = ConvertToGet(rng)
    
    URL = "https://translate.google.pl/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
    Debug.Print URL
    
    With objHTTP
        .Open "GET", URL, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .Send ("")
        If InStr(.responseText, "<div class=""result-container""") > 0 Then
            GoogleTranslate = Clean(RegexExecute(.responseText, "div[^""]*?""result-container"".*?>(.+?)</div>"))
        Else
            GoogleTranslate = CVErr(xlErrValue)
        End If
    End With

End Function


Private Function ConvertToGet(val As String)

    val = Replace(val, " ", "+")
    val = Replace(val, vbNewLine, "+")
    val = Replace(val, "(", "%28")
    val = Replace(val, ")", "%29")
    ConvertToGet = val

End Function

Private Function Clean(val As String)

    val = Replace(val, "&quot;", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "&#39;", "'")
    Clean = val

End Function

Private Function RegexExecute(str As String, reg As String, Optional matchIndex As Long, Optional subMatchIndex As Long) As String

    Dim RegEx, match, Matches

    On Error GoTo ErrorHandler

    Set RegEx = CreateObject("VBScript.RegExp"): RegEx.Pattern = reg
    RegEx.Global = Not (matchIndex = 0 And subMatchIndex = 0)
    If RegEx.Test(str) Then
        Set Matches = RegEx.Execute(str)
        RegexExecute = Matches(matchIndex).SubMatches(subMatchIndex)
        Exit Function
    End If
    
ErrorHandler:
    
    RegexExecute = CVErr(xlErrValue)

End Function


Sub RegisterGoogleTranslatorFunction()

    Dim strFunc As String 'name of the function you want to register
    Dim strDesc As String 'description of the function itself
    Dim strArgs() As String 'description of function arguments
    
    ReDim strArgs(1 To 3) 'The upper bound is the number of arguments in your function
    strFunc = "GoogleTranslate"
    strDesc = "Google Translator Custom function: " & vbNewLine & vbNewLine & _
    "Formula Syntax is =TRANSLATE(''A1'',''en'',''es'')" & vbNewLine & _
    "To autodetect language use 0. Instead of ''en''" & vbNewLine & vbNewLine & _
    "For additional languages visit: https://cloud.google.com/translate/docs/languages/"
    
    strArgs(1) = "Select Cell value to Translate"
    strArgs(2) = "Tranlate FROM Language"
    strArgs(3) = "Tranlate TO Language"
    
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"

End Sub

'***Google Translation Custom Function FINISH ***

(i followed the instructions, adding "microsoft internet control" to the references)
This reference isn't needed because the code doesn't use the InternetExplorer object.
 
Upvote 0
Dear John_w

thank you for your reply: now the function works!
however, is strange that by putting "0" for auto-detect language, sometimes works properly, some other it give me back the original sentence, with no translation. moreover, the behaviour is not the same, and is little strange

in particular, for example, if i have to translate a sentence from german to italian, i write "=GoogleTranslate("sentence in german",0,"it")" gives me the german sentence
after that, if i change the formula in "=GoogleTranslate("sentence in german","de","it")" works properly
after that (and this is very strange) if i change again the formula in "=GoogleTranslate("sentence in german",0,"it")" works again well!! (if i extend the cell to other one, works well with german but no with other languages)

is like he has memory of the last language selected.
is there a way to avoid this behavour?

thank you again
Tommaso
 
Upvote 0
I can't reproduce your issue. Here's a change you can try.

Insert this code immediately below the Option Explicit:
VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#Else
    Private Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
#End If
and add this immediately below the URL = ... line:
VBA Code:
    DeleteUrlCacheEntry URL
 
Upvote 0
Hi all,

thanks for sharing this.
I am having trouble translating from cyrillic text (namely Bulgarian) to English. Latin Bulgarian to English works well, and all everything else in latin alphabet works well. With cyrillic to latin (whichever language) I get question marks as translation. Do you have any solutions for me?
 
Upvote 0
Additionally, latin to cyrillc works fine as well, ie. any other language to Bulgarian
 
Upvote 0

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top