Translating A Spreadsheet

[Dazzawm]

Hi, I have a large spreadsheet with a lot of data that is in Spanish. Is there any way or any code etc that would translate the whole spreadsheet to English? Thanks.

 

[Jon von der Heyden]

Hi

Copy the Translate function from post #5 to a new module in your workbook.

Then add another module to your workbook and add:

Public Sub TranslateSheets()
    Const strDirectory As String = "C:\Users\Jon von der Heyden\Desktop\Desktop Files\temp\"
    Dim strFileName As String
    Dim wksTemp As Excel.Worksheet
    Dim rngCell As Excel.Range


    strFileName = Dir$(strDirectory & "*.xl*")


    Do While Len(strFileName) > 0
        With Excel.Workbooks.Open(Filename:=strDirectory & strFileName, ReadOnly:=True)
            Set wksTemp = ThisWorkbook.Sheets.Add
            wksTemp.Name = .Name
            For Each rngCell In .Sheets(1).UsedRange
                wksTemp.Range(rngCell.Address).Value = Translate(rngCell.Value, Auto_Detect, English)
            Next rngCell
            Call .Close(SaveChanges:=False)
            strFileName = Dir
        End With
    Loop
End Sub

Things to note before running this:
1. Remember that the enum value for J_a_p_anese has been starred out, so amend this in your Translate function (excl. underscore chars).

2. Creates a new sheet in your workbook for each sheet that it translates. Assumes that each workbook in the directory only has a single sheet and names the new sheet according to the workbook name. This may error if the workbook names contains characters that are not allowed in sheet names.

3. Translate from language is auto detected and translated into English - you may wish to change this.

4. The directory path (strDirectory) needs to reflect YOUR directory.

5. You may wish to limit the range that it translates (currently the whole used range); or even skip formula cells (using SpecialCells).

Good luck!

 

[TMM1968]

Thanks for the work on this. When I run it as detailed..i am getting run-time error here.(see bolded line)

strText = Replace$(strText, Chr$(160), "%20")


strUrl = "http://translate.google.com/translate_a/t?client=t&text={S}&hl=en&sl={F}&tl={T}&multires=1&pc=0&rom=1&sc=1"
strUrl = Replace$(strUrl, "{S}", strText)
strUrl = Replace$(strUrl, "{F}", Split(strSHORTCODES, ",")(eFrom))
strUrl = Replace$(strUrl, "{T}", Split(strSHORTCODES, ",")(eTo))


With CreateObject("MSXML2.XMLHTTP")
Call .Open("get", strUrl, False)
Call .Send
strResult = .responseText
End With


strResult = Replace$(Mid$(CStr(Split(strResult, ",")(0)), 4), Chr$(34), "")
Translate = strResult
End Function

 

[Jon von der Heyden]

What is the error?

If you get "The system cannot locate the resource specified." it means it could not make a connection. Check that you are online. Otherwise I'm not sure what would cause this to fail.

 

[hamaraghar]

Hi Jon..

great script. Thanks for sharing.
I have a question though..

In case there are multiple languages in the spreadsheet i.e. spanish, chinese, italian, russian, etc.. will it be possible to do the translations to English.. may be by tweaking the above code.
Please note that the comments in column A is not sorted as per language and it also has English comments.

The other thing I was wondering is that I can still use the same script from you if we can figure out a way to determine the language of each cell, then sort them and with every change in language, we apply your code.

Thanks for your help.

 

[Jon von der Heyden]

Hi and welcome to the board.

In my function, the translate function second argument (i.e. the language being interpreted), can take Auto-Detect (0).

 

[hamaraghar]

Hi Jon,

I tried the code but it doesn't seem to work.
For example, my data is

[TABLE="width: 709"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Я хочу учиться.[/TD]
[/TR]
[TR]
[TD]Jag vill lära mig.[/TD]
[/TR]
[TR]
[TD]Искам да се науча.[/TD]
[/TR]
[TR]
[TD]私は勉強したい。[/TD]
[/TR]
[TR]
[TD]I want to learn.[/TD]
[/TR]
[TR]
[TD]Ich will lernen. Ich muss lernen,[/TD]
[/TR]
[TR]
[TD]나는 배우고 싶다. 내가 배울 필요가[/TD]
[/TR]
[TR]
[TD]我想学习。我需要学习的。

It is able to translate few. It is not able to translate anything after a "." i.e. period.

Thanks for your help once again.

[/TD]
[/TR]
</tbody>[/TABLE]

 

[Jon von der Heyden]

Hi

I believe that the problem is that Google is unable to detect the languages for some of those strings, or able to detect it but unable to make a valid translation.

It's not a problem with the function per se, it just cannot be resolved.

 

[whydowetoregister]

Thanks, but I just cant get it to work. There is no 'OK' to click. I am using 2010 is it different? It only seems to put the word that is in the first cell also and I need the whole sheet translated.

Dazzawm, I have the same problem -- there is no 'OK' button to click. (I am using Excel 2010). According to Microsoft, you might need to 'enable the OK button'. HEre is what they say:

"Enable the Translate the whole document option
1. In the Research pane, click Research options.
2. In the Update or Remove Services dialog box, click Update/Remove, select WorldLingo, click Update, and then follow the instructions.
3. Follow the steps to translate the whole document."

Source: Translate text - support - Office.com

You may also want to read this:
http://office.microsoft.com/en-us/p...ge-research-services-HP001037788.aspx?redir=0
And this:
http://blogs.msdn.com/b/translation/p/office.aspx

 

[mattomrog]

Jon - Thanks for the brilliant piece of code. Exactly what I needed. The function works well for me EXCEPT...

It's not wording for Chinese and Japanese characters (very important for my application). I did a debug.print and this is the URL it's sending out for Italian (which works):

"http://translate.google.com/translate_a/t?client=t&text=Ciao&hl=en&sl=it&tl=en&multires=1&pc=0&rom=1&sc=1"

And this is the url it's sending out for Chinese, which is returning ? ? ? ? from an input of 换现金支票

"http://translate.google.com/translate_a/t?client=t&text=?????&hl=en&sl=zh&tl=en&multires=1&pc=0&rom=1&sc=1"

Any ideas?

Thanks!

Matt

 

[Jon von der Heyden]

My my this seems to be a popular one! I had been meaning to come back to this for some time now (I have been frantically busy), but it seems my work has been done for me. I received an email from a chap called Cody Holland yesterday with a solution. He added an encoder and it works brilliantly, now supporting all of those languages that needed encoding.

In a standard module:

Option Explicit


Private Const CP_UTF8 = 65001


Private Declare Function WideCharToMultiByte Lib "Kernel32" ( _
        ByVal CodePage As Long, ByVal dwflags As Long, _
        ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
        ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, _
        ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long


Public Function UTF16To8(ByVal strUTF16 As String) As String
    Dim strBuffer       As String
    Dim lngLength       As Long
    
    If Len(strUTF16) Then
        lngLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUTF16), -1, 0, 0, 0, 0)
        strBuffer = Space$(lngLength)
        lngLength = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUTF16), -1, StrPtr(strBuffer), Len(strBuffer), 0, 0)
        strBuffer = StrConv(strBuffer, vbUnicode)
        UTF16To8 = Left$(strBuffer, lngLength - 1)
    Else
        UTF16To8 = ""
    End If
End Function


Public Function URLEncode(ByVal strVal As String, _
                          Optional ByVal blnSpaceAsPlus As Boolean = False, _
                          Optional ByVal blnUTF8Encode As Boolean = True) As String


    Dim strValCopy      As String
    Dim strLen          As Long
    Dim varResult       As Variant
    Dim lngChar         As Long
    Dim lngCharCode     As Integer
    Dim strChar         As String
    Dim strSpace        As String
    
    strValCopy = IIf(blnUTF8Encode, UTF16To8(strVal), strVal)
    strLen = Len(strValCopy)
    
    If strLen > 0 Then
        ReDim varResult(strLen) As String
    
        If blnSpaceAsPlus Then
            strSpace = "+"
        Else
            strSpace = "%20"
        End If
    
        For lngChar = 1 To strLen
            strChar = Mid$(strValCopy, lngChar, 1)
            lngCharCode = Asc(strChar)
            Select Case lngCharCode
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    varResult(lngChar) = strChar
                Case 32
                    varResult(lngChar) = strSpace
                Case 0 To 15
                    varResult(lngChar) = "%0" & Hex(lngCharCode)
                Case Else
                    varResult(lngChar) = "%" & Hex(lngCharCode)
            End Select
        Next lngChar
        
        URLEncode = Join$(varResult, "")
    End If
End Function

Stick the translate function in a separate module:

Option Explicit


Private Const strSHORTCODES As String = ",en,af,sq,ar,hy,az,eu,be,bn,bg,ca,zh,hr,cs,da,nl,eo,et,tl,fi,fr,gl,ka,de,el,gu,ht,iw,hi,hu,is,id,ga,it,ja,kn,ko,lo,la,lv,lt,mk,ms,mt,no,fa,pl,pt-PT,ro,ru,sr,sk,sl,es,sw,sv,ta,te,th,tr,uk,ur,vi,cy,yi"


Public Enum eLanguage
    auto_detect = 0
    english = 1
    afrikaans = 2
    Albanian = 3
    Arabic = 4
    Armenian = 5
    Azerbaijani = 6
    Basque = 7
    Belarusian = 8
    Bengali = 9
    Bulgarian = 10
    Catalan = 11
    Chinese = 12
    Croatian = 13
    Czech = 14
    Danish = 15
    Dutch = 16
    Esperanto = 17
    Estonian = 18
    Filipino = 19
    Finnish = 20
    French = 21
    Galician = 22
    Georgian = 23
    German = 24
    Greek = 25
    Gujarati = 26
    Haitian_Creole = 27
    Hebrew = 28
    Hindi = 29
    Hungarian = 30
    Icelandic = 31
    Indonesian = 32
    Irish = 33
    Italian = 34
    Japanese = 35
    Kannada = 36
    Korean = 37
    Lao = 38
    Latin = 39
    Latvian = 40
    Lithuanian = 41
    Macedonian = 42
    Malay = 43
    Maltese = 44
    Norwegian = 45
    Persian = 46
    Polish = 47
    Portuguese = 48
    Romanian = 49
    Russian = 50
    Serbian = 51
    Slovak = 52
    Slovenian = 53
    Spanish = 54
    Swahili = 55
    Swedish = 56
    Tamil = 57
    Telugu = 58
    Thai = 59
    Turkish = 60
    Ukrainian = 61
    Urdu = 62
    Vietnamese = 63
    Welsh = 64
    Yiddish = 65
End Enum


Public Function Translate(ByVal strText As String, _
                          Optional ByVal eFrom As eLanguage = auto_detect, _
                          Optional ByVal eTo As eLanguage = english, _
                          Optional ByVal blnPhonetic As Boolean = False) As String
    
    Dim strUrl
    Dim strTransText As String
    Dim strResult As String
    Dim varSplitText As Variant
    Dim lngItem As Long
    
    If strText = "" Then
        Translate = ""
        Exit Function
    End If
    
    strText = URLEncode(strText)
    
    strUrl = "http://translate.google.com/translate_a/t?client=t&text={S}&hl=en&sl={F}&tl={T}&multires=1&pc=0&rom=1&sc=1"
    
    strUrl = Replace$(strUrl, "{S}", strText)
    strUrl = Replace$(strUrl, "{F}", Split(strSHORTCODES, ",")(eFrom))
    strUrl = Replace$(strUrl, "{T}", Split(strSHORTCODES, ",")(eTo))


    
    With CreateObject("MSXML2.XMLHTTP")
        Call .Open("get", strUrl, False)
        Call .Send
        strResult = .responseText
    End With


    varSplitText = Split(Split(strResult, "]],")(0), "[")


    If Not blnPhonetic Then
        For lngItem = 3 To UBound(varSplitText)
            strTransText = strTransText & Split(varSplitText(lngItem), ",")(0)
        Next
    Else
        For lngItem = 3 To UBound(varSplitText)
            strTransText = strTransText & Split(varSplitText(lngItem), ",")(2)
        Next
    End If
    strResult = Replace(strTransText, """", "")


    Translate = strResult
End Function

Cody also added another argument to the function so that you can choose either the literal translation or the phonetic translation. The default is literal translation.

You can download a sample workbook here.

I will try and get around to updating the blog post - hopefully this year still. Thanks Cody Holland for sharing your discovery with me.