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 ***
 
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.
Good idea i added that peace of code and now it's indeed no longer capital sensitive, thanks!

For the record, in europe we need to use < ; > in our formula's wherever people in the US need to use < , >
For us < , > is the decimal sign and < . > is the thousands separator.

So previously the formula was already working, as long as the language abbreviations were in small caps.
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
hello friends
It works well with the conversion from English to Arabic, but it does not work as required with the opposite,
I hope you find a solution if you can
Thank you
 
Upvote 0
Arabic to English works for me:
VBA Code:
Public Sub Test2()
   
    Dim inputText As String, translation As String
   
    inputText = Range("A24").Value
    translation = GoogleTranslate(inputText, "ar", "en")
    Range("A25").Value = translation
    MsgBoxW inputText & vbCrLf & translation
       
End Sub
1648395558880.png
 
Upvote 0
Hey all
First thx for this fantastic function :)
It is excatley what i need and gonne use every day.

However here is my issue.

I write in column B1-30 and i want this script to run in column C1-30
To start with B1-30 is emty and I call the script in C1-30 with =GoogleTranslate(B20;"da";"en")
It works and does translate corectly in C20 WHEN I write in B20
But if B20 (or any other cell) is emty the script returns this:
</div><div class="links-container"><ul><li><a href="Google">Googles startside</a></li><li><a href="https://www.google.com/tools/feedback/survey/xhtml?productId=95112&hl=da">Send feedback</a></li><li><a href="https://www.google.com/intl/da/policies">Privatliv og vilkår</a></li><li><a href="./full">Skift til hele websitet</a></li></ul>
So the quistion is. Is there a way to not show all this if B20 is emty?
It whould be nice if it said like "enter values in B20" or something like that or just #values missing.
 
Upvote 0
I write in column B1-30 and i want this script to run in column C1-30
To start with B1-30 is emty and I call the script in C1-30 with =GoogleTranslate(B20;"da";"en")
It works and does translate corectly in C20 WHEN I write in B20
But if B20 (or any other cell) is emty the script returns this:
</div><div class="links-container"><ul><li><a href="Google">Googles startside</a></li><li><a href="https://www.google.com/tools/feedback/survey/xhtml?productId=95112&hl=da">Send feedback</a></li><li><a href="https://www.google.com/intl/da/policies">Privatliv og vilkår</a></li><li><a href="./full">Skift til hele websitet</a></li></ul>
So the quistion is. Is there a way to not show all this if B20 is emty?
Simply put the call inside an IF function:
Excel Formula:
=IF(B1<>"",GoogleTranslate(B1,"da","en"),"Enter text in " & SUBSTITUTE(CELL("address",B1),"$",""))
 
Upvote 0
Simply put the call inside an IF function:
Excel Formula:
=IF(B1<>"",GoogleTranslate(B1,"da","en"),"Enter text in " & SUBSTITUTE(CELL("address",B1),"$",""))
Thx for the feed back.
worked like a charm :)
 
Upvote 0
Hi all, first of all I wanted to say that the macro works nicely.

However I have a challenge with trying to get cells translated if the cell contains an inner enter

For example if a single cell contains 2 or more line breaks/enters. For example:

Sentence 1
Sentence 2

It will then not be able to translate the text. I think it has something to do with the RegEx but I am totally new to RegEx so I do not know where or how to start modifying it whilst I think everyone encounters this problem.
 
Upvote 0
However I have a challenge with trying to get cells translated if the cell contains an inner enter

Simply use the CLEAN function to remove all non-printable characters:

Excel Formula:
=GoogleTranslate(CLEAN(B7),"en","fr")
 
Upvote 0
Simply use the CLEAN function to remove all non-printable characters:

Excel Formula:
=GoogleTranslate(CLEAN(B7),"en","fr")
Is there a way to retain the linebreaks? without removing the non printable charcters or put back the line breaks after scraping the translated text?
Since I have literally texts and synopsis in my sheet
 
Upvote 0
Is there a way to retain the linebreaks? without removing the non printable charcters or put back the line breaks after scraping the translated text?

As you thought, the regex needs changing to treat line breaks the same as any character. Change shown in bold.

Old regex: div[^"]*?"result-container".*?>(.+?)</div>

New regex: div[^"]*?"result-container".*?>([\s\S]+?)</div>

Latest GoogleTranslate function, supporting functions and Test routine. Regex changed to handle line breaks in the text to be translated and preserve them in the translation.

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 English text to translate to Spanish")
    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")
   
    If Val(Application.Version) >= 15 Then
        'Excel 2013 and later versions - encode the Google Translate URL using the WorksheetFunction.EncodeURL function
        URL = "https://translate.google.com/m?hl=" & LCase(fromLanguage) & "&sl=" & LCase(fromLanguage) & "&tl=" & LCase(toLanguage) & "&ie=UTF-8&prev=_m&q=" & WorksheetFunction.EncodeURL(text)
    Else
        'Excel 2010 and earlier versions - encode the Google Translate URL using our own function
        URL = "https://translate.google.com/m?hl=" & LCase(fromLanguage) & "&sl=" & LCase(fromLanguage) & "&tl=" & LCase(toLanguage) & "&ie=UTF-8&prev=_m&q=" & URLEncode(text)
    End If
   
    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
            'OLD GoogleTranslate = Clean(RegexExecute(.responseText, "div[^""]*?""result-container"".*?>(.+?)</div>"))
            GoogleTranslate = Clean(RegexExecute(.responseText, "div[^""]*?""result-container"".*?>([\s\S]+?)</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

    Static RegEx As Object
    Dim matches As Object

    On Error GoTo ErrorHandler

    If RegEx Is Nothing Then 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


'VBA function to URL-encode a string because WorksheetFunction.EncodeURL is only available in Excel 2013 and later
'https://stackoverflow.com/a/218199
'with late binding of Microsoft ActiveX Data Objects, so no VBA project reference is required

Public Function URLEncode(ByVal StringVal As String, Optional SpaceAsPlus As Boolean = False) As String

    Dim bytes() As Byte, b As Byte, i As Integer, space As String
   
    Const adTypeBinary = 1
    Const adTypeText = 2
    Const adModeReadWrite = 3

    If SpaceAsPlus Then space = "+" Else space = "%20"
   
    If Len(StringVal) > 0 Then
        With CreateObject("ADODB.Stream") 'New ADODB.Stream
            .Mode = adModeReadWrite
            .Type = adTypeText
            .Charset = "UTF-8"
            .Open
            .WriteText StringVal
            .Position = 0
            .Type = adTypeBinary
            .Position = 3 ' skip BOM
            bytes = .Read
        End With
       
        ReDim result(UBound(bytes)) As String
       
        For i = UBound(bytes) To 0 Step -1
            b = bytes(i)
            Select Case b
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    result(i) = Chr(b)
                Case 32
                    result(i) = space
                Case 0 To 15
                    result(i) = "%0" & Hex(b)
                Case Else
                    result(i) = "%" & Hex(b)
            End Select
        Next i
       
        URLEncode = Join(result, "")
    End If
   
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 arguments: [Macro], [Description], [HasMenu], [MenuText], [HasShortcutKey], [ShortcutKey], [Category], [StatusBar], [HelpContextID], [HelpFile], [ArgumentDescriptions]
    'https://stackoverflow.com/questions/27962808/excel-user-defined-functions-cant-use-argumentdescriptions-in-excel-2007-im-t
   
    #If VBA7 Then
        'Excel 2010 and later - ArgumentDescriptions argument is supported
        Application.MacroOptions Macro:=strFunc, Description:=strDesc, Category:="User Defined", ArgumentDescriptions:=strArgs
    #Else
        'Excel 2007 and earlier - ArgumentDescriptions argument is not supported
        Application.MacroOptions Macro:=strFunc, Description:=strDesc, Category:="User Defined"
    #End If
       
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
 
Last edited:
Upvote 1

Forum statistics

Threads
1,214,641
Messages
6,120,692
Members
448,979
Latest member
DET4492

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