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 ***
 
Hi John,
thank you.

Here is the example where I translate from English to Bulgarian, and I get the result, but when I try other way round, I get question marks:
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
2021-01-08_15-46-41.png
 
Upvote 0
I have fixed the problem. The original Cyrillic text needs to be URL-encoded in the query string (the &q= value), which be done with the EncodeURL worksheet function.

Other changes:
  • Use translate.google.com, rather than the OP's translate.google.pl.
  • Added the MsgBoxW function which mimics the VBA MsgBox function, but displays strings containing Cyrillic and other foreign characters correctly rather than with "?" characters. If required, you can call this function from your own code (an example call in GoogleTranslate is currently commented out).
  • Updated the RegisterGoogleTranslateFunction helper routine.
VBA Code:
'https://cloud.google.com/translate/docs/languages/
'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(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)
    Debug.Print URL
    DeleteUrlCacheEntry 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>"))
            'MsgBoxW text & vbCrLf & vbCrLf & GoogleTranslate
        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

Public 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
dear john_w,
thank you again
unfortunately, the code does not work yet properly
let me share the code (is the same of the post, with your suggestions)
may be you can find the error

VBA Code:
Option Explicit

#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

    
'***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
    
    DeleteUrlCacheEntry URL
    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 ***

thank you again
Tommaso
 
Upvote 0
i have the same problem: with autodetect mode sometimes works properly, but many times no.
for instance trying to translate a sentence from english to english (with autodetect mode: i never know the language of the sentence) he seems to consider the language of the previous sentence (soy milk => i am milk) !!!! (previous sentence was in spanish)
sometimes he don't translate from some languages (es ita to en).
but it seems he has not the same behaviour...
 
Upvote 0
i have the same problem: with autodetect mode sometimes works properly, but many times no.
for instance trying to translate a sentence from english to english (with autodetect mode: i never know the language of the sentence) he seems to consider the language of the previous sentence (soy milk => i am milk) !!!! (previous sentence was in spanish)
sometimes he don't translate from some languages (es ita to en).
but it seems he has not the same behaviour...

no one had the same behaviour? how can i solve this problem?
thank you
 
Upvote 0
no one had the same behaviour? how can i solve this problem?
thank you
Are you using the latest code? Here:

 
Upvote 0
Are you using the latest code? Here:

yes,
but it give me an error
DeleteUrlCacheEntry ==> Sub or Function not defined
i guess is some reference missing? (but i don't find which one- i don't have any reference wich name include "url"- if you can tell me the reference to activate would be great!)
 
Upvote 0
DeleteUrlCacheEntry ==> Sub or Function not defined
The declaration for DeleteUrlCacheEntry is actually in the code you posted, but not my latest code. Add this at the top of the module, between Option Explicit (if present) and Public Function GoogleTranslate:

VBA Code:
#If VBA7 Then
    Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    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 DeleteUrlCacheEntry Lib "Wininet.dll" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
    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
 
Upvote 0

Forum statistics

Threads
1,223,721
Messages
6,174,097
Members
452,542
Latest member
Bricklin

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