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 ***
 
dear John_w, thank you again
now the problem on DeleteUrlCacheEntry is fixed.
BUT unfortunately the function don't work properly again.
sometimes works properly, but once it translate from spanish or some other languages, it stop automatically detect the correct language for the entrance
(note that i use this function in a specific cell, changing the text in the input cell - i don't think is relevant, but may be can help to understand)
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
means that i put in a cell the text to translate, of which i don't know the language (for instance cell B3) and avery time i change the sentence.

in this case i've "forced" to recognize the german language by putting "de", and obviously it works
1612103437290.png


but after changing "de" with 0 or "" it still works with german or some other languages, but if i change the sentence, for example french, it does not work anymore
1612103565641.png


NOTE that if i do again the same ( forcing french in the function input with "fr" and then replace with 0 for autodetect) it works with french and some other languages but no more with german.

it seems it has memory of the previous language selected, avoiding the autodetect mode
 
Upvote 0
I can't reproduce your problem with "0" for autodetect language. You could try changing these lines:
VBA Code:
    Static objHTTP As Object
    If objHTTP Is Nothing Then Set objHTTP = CreateObject("MSXML2.XMLHTTP")
to:
VBA Code:
    Dim objHTTP As Object
    Set objHTTP = CreateObject("MSXML2.XMLHTTP")
 
Upvote 0
Dear John_w,
unfortunately it seems there is no way to solve the problem of auto detect language.. but thank you so much for your suggestions!!
 
Upvote 0
Thank you to everyone that has helped to develop this solution. It is incredibly handy.

And just a reminder for anyone that is using it for large amounts of data that reading and writing from each cell is incredibly s...l...o...w.

Create a routine that will load the data into an array or similar and it goes so much faster.
 
Upvote 0
Latest GoogleTranslate function with Test routine. No functional changes, but dropped the call to DeleteUrlCacheEntry because it isn't really needed.

VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long
#Else
    Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
#End If


Public Sub Test()
    
    Dim inputText As String, translation As String
    
    inputText = InputBox("Enter text to translate")
    If inputText <> "" Then
        translation = GoogleTranslate(inputText, "en", "es")   'English to Spanish
        Range("A1").Value = inputText
        Range("A2").Value = translation
        MsgBoxW inputText & vbCrLf & translation
    End If
        
End Sub


'Google Language Codes - full list at https://cloud.google.com/translate/docs/languages/

'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 Telugu = te
'Bengali = bn Filipino = tl Hindi = hi Latin = la Romanian = ro Thai = th

Public Function GoogleTranslate(text As String, Optional fromLanguage As String = "en", Optional toLanguage As String = "es") As String

    Static objHTTP As Object
    Dim URL As String
    
    If objHTTP Is Nothing Then Set objHTTP = CreateObject("MSXML2.XMLHTTP")
    
    URL = "https://translate.google.com/m?hl=" & fromLanguage & "&sl=" & fromLanguage & "&tl=" & toLanguage & "&ie=UTF-8&prev=_m&q=" & WorksheetFunction.EncodeURL(text)
    
    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 Clean(val As String) 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


Private Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Excel") As VbMsgBoxResult
    Prompt = Prompt & vbNullChar 'Add null terminators
    Title = Title & vbNullChar
    MsgBoxW = MessageBoxW(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function


Public Sub RegisterGoogleTranslateFunction()

    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 = "Translates a text string from the specified language (default English) to another language. Language codes are listed at https://cloud.google.com/translate/docs/languages/"
    strArgs(1) = "Text string to translate."
    strArgs(2) = "Translate FROM language code.  Default ""en"" (English); use ""0"" to automatically detect the language."
    strArgs(3) = "Translate TO language code.  Default ""es"" (Spanish)."
    
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"
    
End Sub


Public Sub DeregisterGoogleTranslateFunction()

    Dim strFunc As String 'name of the function you want to deregister
    
    strFunc = "GoogleTranslate"
    Application.MacroOptions Macro:=strFunc, Description:=Empty, Category:=Empty
    
End Sub
 
Upvote 0
Latest GoogleTranslate function with Test routine. No functional changes, but dropped the call to DeleteUrlCacheEntry because it isn't really needed.

VBA Code:
Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long
#Else
    Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
#End If


Public Sub Test()
   
    Dim inputText As String, translation As String
   
    inputText = InputBox("Enter text to translate")
    If inputText <> "" Then
        translation = GoogleTranslate(inputText, "en", "es")   'English to Spanish
        Range("A1").Value = inputText
        Range("A2").Value = translation
        MsgBoxW inputText & vbCrLf & translation
    End If
       
End Sub


'Google Language Codes - full list at https://cloud.google.com/translate/docs/languages/

'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 Telugu = te
'Bengali = bn Filipino = tl Hindi = hi Latin = la Romanian = ro Thai = th

Public Function GoogleTranslate(text As String, Optional fromLanguage As String = "en", Optional toLanguage As String = "es") As String

    Static objHTTP As Object
    Dim URL As String
   
    If objHTTP Is Nothing Then Set objHTTP = CreateObject("MSXML2.XMLHTTP")
   
    URL = "https://translate.google.com/m?hl=" & fromLanguage & "&sl=" & fromLanguage & "&tl=" & toLanguage & "&ie=UTF-8&prev=_m&q=" & WorksheetFunction.EncodeURL(text)
   
    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 Clean(val As String) 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


Private Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Excel") As VbMsgBoxResult
    Prompt = Prompt & vbNullChar 'Add null terminators
    Title = Title & vbNullChar
    MsgBoxW = MessageBoxW(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function


Public Sub RegisterGoogleTranslateFunction()

    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 = "Translates a text string from the specified language (default English) to another language. Language codes are listed at https://cloud.google.com/translate/docs/languages/"
    strArgs(1) = "Text string to translate."
    strArgs(2) = "Translate FROM language code.  Default ""en"" (English); use ""0"" to automatically detect the language."
    strArgs(3) = "Translate TO language code.  Default ""es"" (Spanish)."
   
    Application.MacroOptions Macro:=strFunc, Description:=strDesc, ArgumentDescriptions:=strArgs, Category:="Custom Category"
   
End Sub


Public Sub DeregisterGoogleTranslateFunction()

    Dim strFunc As String 'name of the function you want to deregister
   
    strFunc = "GoogleTranslate"
    Application.MacroOptions Macro:=strFunc, Description:=Empty, Category:=Empty
   
End Sub
thanks will try this code
 
Upvote 0
I struggled with this macro for hours, just not understanding why it wasn't working for me. In the end, i found it.

For anyone who might be as stupid as me... it's capital sensitive, so =googletranslate(A1;"EN";"DE") won't work properly, you'll just get your content translated to whatever language you last translated to in Googletranslate.

Luckily =googletranslate(A1;"en";"de") does work.

K
 
Upvote 0
I struggled with this macro for hours, just not understanding why it wasn't working for me. In the end, i found it.

For anyone who might be as stupid as me... it's capital sensitive, so =googletranslate(A1;"EN";"DE") won't work properly, you'll just get your content translated to whatever language you last translated to in Googletranslate.

Luckily =googletranslate(A1;"en";"de") does work.

K
Interesting finding, here is a VBA solution where it changes the string to lower case. Just add LCase to this two strings: fromLanguage and toLanguage at URL Variable.

Here is the VBA Code line fixed (Replace original one):

VBA Code:
URL = "https://translate.google.com/m?hl=" & fromLanguage & "&sl=" & LCase(fromLanguage) & "&tl=" & LCase(toLanguage) & "&ie=UTF-8&prev=_m&q=" & WorksheetFunction.EncodeURL(text)

As well, you're using ; (semicolon) instead of , (Comma) in your formula. That's also a reason why it doesn't work.
 
Upvote 0
Interesting finding, here is a VBA solution where it changes the string to lower case. Just add LCase to this two strings: fromLanguage and toLanguage at URL Variable.

Here is the VBA Code line fixed (Replace original one):

VBA Code:
URL = "https://translate.google.com/m?hl=" & fromLanguage & "&sl=" & LCase(fromLanguage) & "&tl=" & LCase(toLanguage) & "&ie=UTF-8&prev=_m&q=" & WorksheetFunction.EncodeURL(text)

As well, you're using ; (semicolon) instead of , (Comma) in your formula. That's also a reason why it doesn't work.

As well, an other improvement its to include Application.Volatile as part of the function.

VBA Code:
Application.Volatile

Explanation:
Marks a user-defined function as volatile. A volatile function must be recalculated whenever calculation occurs in any cells on the worksheet. A nonvolatile function is recalculated only when the input variables change. This method has no effect if it's not inside a user-defined function used to calculate a worksheet cell.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,161
Members
453,021
Latest member
Justyna P

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