Translating A Spreadsheet

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,783
Office Version
  1. 365
Platform
  1. Windows
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.
 
Hi there,

This is a remarkable thread... :pray:

Recently I have started getting files with some Arabic text (RTL...), which I need to translate to English.
I have tested the function and it works great (thanks a million, for that) but I am looking for a slightly different solution.
Because I need to maintain the original file in its as-is format, I am looking for a code that will do 2 things:
1. Replace the Arabic text with the English translation (within the original cell).
2. Run on multiple selected cells (a range), rather that manually use the function to translate cell by cell.

Being a novice coder, I know my limitations :eeek:, so any help in the right direction will be greatly appreciated.

I thank you in advance for your time and attention
 
Upvote 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Hello,
following code with the function in previous post does what you are looking for .

Code:
Sub TranslateSelection()

    For r = 1 To Selection.Rows.Count
        For s = 1 To Selection.Columns.Count
           If Selection.Cells(r, s).Value <> "" Then
              Selection.Cells(r, s).Value = Translate(Selection.Cells(r, s).Value, Arabic, English)
            End If
        Next s
    Next r


End Sub
 
Upvote 0
Good Day All It is work well ,But not support Arabic to En

</xml><![endif]--></head>****** ><div class=WordSection1><table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 width=1111 style='width:833.0pt;margin-left:-.15pt;border-collapse:collapse'><tr style='height:15.0pt'><td width=23 nowrap valign=bottom style='width:17.0pt;border:solid windowtext 1.0pt;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'> <o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>A<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>B<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>C<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>D<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>E<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>F<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>G<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>H<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>I<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>J<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>K<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>L<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>M<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>N<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>O<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>P<o:p></o:p></span></p></td><td width=64 nowrap style='width:48.0pt;border:solid windowtext 1.0pt;border-left:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>Q<o:p></o:p></span></p></td></tr><tr style='height:15.0pt'><td width=23 nowrap style='width:17.0pt;border:solid windowtext 1.0pt;border-top:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>1<o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=right dir=RTL style='text-align:left'><span lang=AR-SA style='color:black'>ÞãÑ</span><span dir=LTR style='color:black'><o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:red'>???<span lang=AR-SA dir=RTL><o:p></o:p></span></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span lang=AR-SA dir=RTL style='color:black'> </span><span style='color:black'><o:p></o:p></span></p></td><td width=256 nowrap colspan=4 valign=bottom style='width:192.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>[[</span><span style='color:red'>["???","???"</span><span style='color:black'>,null,null,3]],null,"ar"]<o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'> <o:p></o:p></span></p></td><td width=576 nowrap colspan=9 valign=bottom style='width:6.0in;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'>https://translate.googleapis.com/translate_a/single?client=gtx&sl=ar&tl=en&dt=t&q=<span lang=AR-SA dir=RTL>ÞãÑ</span><o:p></o:p></span></p></td></tr><tr style='height:15.0pt'><td width=23 nowrap style='width:17.0pt;border:solid windowtext 1.0pt;border-top:none;background:#BDD7EE;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>2<o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'>Moon<o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=right dir=RTL style='text-align:left'><span lang=AR-SA style='color:black'>ÇáÞãÑ</span><span dir=LTR style='color:black'><o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'> <span lang=AR-SA dir=RTL><o:p></o:p></span></span></p></td><td width=256 nowrap colspan=4 valign=bottom style='width:192.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span dir=LTR></span><span dir=LTR></span><span style='color:black'><span dir=LTR></span><span dir=LTR></span>[[["<span lang=AR-SA dir=RTL>ÇáÞãÑ</span><span dir=LTR></span><span dir=LTR></span><span dir=LTR></span><span dir=LTR></span>","Moon",null,null,1]],null,"en"]<o:p></o:p></span></p></td><td width=64 nowrap valign=bottom style='width:48.0pt;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><span style='color:black'> <o:p></o:p></span></p></td><td width=576 nowrap colspan=9 valign=bottom style='width:6.0in;border-top:none;border-left:none;border-bottom:solid windowtext 1.0pt;border-right:solid windowtext 1.0pt;padding:0in 5.4pt 0in 5.4pt;height:15.0pt'><p class=MsoNormal align=center style='text-align:center;direction:ltr;unicode-bidi:embed'><span style='color:black'>https://translate.googleapis.com/translate_a/single?client=gtx&sl=en&tl=ar&dt=t&q=Moon<o:p></o:p></span></p></td></tr></table><p class=MsoNormal style='text-align:left;direction:ltr;unicode-bidi:embed'><o:p> </o:p></p></div></body></html>

Code:
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
    English
    Afrikaans
    Albanian
    Arabic
    Armenian
    Azerbaijani
    Basque
    Belarusian
    Bengali
    Bulgarian
    Catalan
    Chinese
    Croatian
    Czech
    Danish
    Dutch
    Esperanto
    Estonian
    Filipino
    Finnish
    French
    Galician
    Georgian
    German
    Greek
    Gujarati
    Haitian_Creole
    Hebrew
    Hindi
    Hungarian
    Icelandic
    Indonesian
    Irish
    Italian
    Japanese
    Kannada
    Korean
    Lao
    Latin
    Latvian
    Lithuanian
    Macedonian
    Malay
    Maltese
    Norwegian
    Persian
    Polish
    Portuguese
    Romanian
    Russian
    Serbian
    Slovak
    Slovenian
    Spanish
    Swahili
    Swedish
    Tamil
    Telugu
    Thai
    Turkish
    Ukrainian
    Urdu
    Vietnamese
    Welsh
    Yiddish
End Enum


Public Function Translate(ByVal strText As String, _
                          Optional ByVal eFrom As String, _
                          Optional ByVal eTo As String) As String
    Dim strUrl As String
    Dim strResult As String


    strText = Replace$(strText, Chr$(32), "%20")
    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"' not work
    
    'strUrl = "https://translate.google.com/#{F}/{T}/{S}"
        strUrl = "https://translate.googleapis.com/translate_a/single?client=gtx&sl={F}&tl={T}&dt=t&q={S}"
    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
    
    '''''''''''''''''''Temprary''''''''''''''''''''''
    If eFrom = Arabic Then                          '
    [I1] = strUrl ' remove it as you need( for test)'
    [D1] = strResult                                '
    Else                                            '
    [I2] = strUrl ' remove it as you need( for test)'
    [D2] = strResult                                '
    End If                                          '
    '''''''''''''''''''''''''''''''''''''''''''''''''
    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), "delimitChar")(2)
        Next
    End If
    strResult = Replace(strTransText, """", "")
    Translate = strResult
    
    
    
    
End Function
Public Sub TranslateSheet()
    Dim wksForeign As Excel.Worksheet
    Dim wksResults As Excel.Worksheet
    Dim rngCell As Excel.Range


    Set wksForeign = Worksheets(1)
 
'''''''''''''''''''''Temprary you can remove'''''''''''''''''''''''
    With wksForeign
    .Cells.Clear
    .Range("A1") = ChrW(1602) & ChrW(1605) & ChrW(1585) '
    .Range("A2") = "Moon" '
    .Range("A1").Offset(0, 1).Value2 = Translate(.Range("A1").Value2, Arabic, English)
    .Range("A2").Offset(0, 1).Value2 = Translate(.Range("A2").Value2, English, Arabic)
    End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''0
    For Each rngCell In wksForeign.Range("A1:A2")
        'rngCell.Offset(0, 1).Value2 = Translate(rngCell.Value2, Arabic, English)
    Next rngCell
End Sub
 
Upvote 0
I have the solution by using UTF-8

PLS DownLoad Below File:
WorkBook

Code:
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 Sub Test()
' From English
    Dim wksForeign As Excel.Worksheet
    Dim wksResults As Excel.Worksheet
    Dim rngCell As Excel.Range




    Set wksForeign = Worksheets(1)
 
    For Each rngCell In Selection 'wksForeign.Range("A1:A20")
        rngCell.Offset(0, 1).Value2 = Translate(rngCell.Value2, English, Arabic)
    Next rngCell
End Sub


Public Sub Test2()
' To English
    Dim wksForeign As Excel.Worksheet
    Dim wksResults As Excel.Worksheet
    Dim rngCell As Excel.Range




    Set wksForeign = Worksheets(1)
 
    For Each rngCell In Selection 'wksForeign.Range("A1:A20")
        rngCell.Offset(0, 1).Value2 = Translate(rngCell.Value2, Arabic, English)
    Next rngCell
End Sub


Public Function Translate(ByVal strText As String, _
                          Optional ByVal eFrom As eLanguage = Auto_Detect, _
                          Optional ByVal eTo As eLanguage = English) As String
                          
    Dim strUrl As String
    Dim strResult As String
        
    strUrl = "https://translate.googleapis.com/translate_a/single?client=gtx&sl={F}&tl={T}&dt=t&q={S}"
    
    strUrl = Replace$(strUrl, "{S}", UTF8_Encode(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), "delimitChar")(2)
        Next
    End If
    strResult = Replace(strTransText, """", "")
    Translate = strResult
End Function


Public Function UTF8_Encode(ByVal strIn As String) As String
'Returns a URI string representing the Hexadecimal UTF-8 representation of strIn.
'Modified from code on this page: http://www.nonhostile.com/howto-convert-byte-array-utf8-string-vb6.asp
'Now handles Unicode surrogate pairs.
'
'There's a bit of an issue with how to handle control characters (code points < &H20). As the code
'is currently written line feeds (LF) and tabs are stripped and carriage returns (CR) are replaced
'with spaces. This works well for the Speak function. Leaving in the CRs causes them to be returned,
'as XML. The XML then gets spoken. This is not ideal for the Translate function. Stripping the CRs
'obviously hurts the original formating. This is just a demo, so I've left this unresolved.


'4/17/2013 Greg Zjaba


Dim lngPos As Long
Dim lngUSV As Long
Dim strUTF8 As String


strIn = Trim(strIn)
For lngPos = 1 To Len(strIn)
    lngUSV = MakeUSV(Mid$(strIn, lngPos, 2))
    If lngUSV < &H10 And lngUSV <> &HA And lngUSV <> &H9 Then
        'Single digit code points. Need to add 0 after %.
        'IMPORTANT NOTE: Also stripping LF and Tab
        If lngUSV <> &HD Then 'CR
            strUTF8 = strUTF8 & "%0" & Hex(AscW(Mid$(strIn, lngPos, 1)))
        Else
            strUTF8 = strUTF8 & "%20" 'Replace CR with space.
        End If
    ElseIf lngUSV > &H1F And lngUSV < &H80 Then
        'US-ASCII - Basic Latin
        strUTF8 = strUTF8 & "%" & Hex(AscW(Mid$(strIn, lngPos, 1)))
    ElseIf lngUSV > &H7F And lngUSV < &H800 Then
        'Basic Multilingual Plane
        strUTF8 = strUTF8 & "%" & Hex((lngUSV \ &H40) Or &HC0)
        strUTF8 = strUTF8 & "%" & Hex((lngUSV And &H3F) Or &H80)
    ElseIf lngUSV > &H7FF And lngUSV < &H10000 Then
        'Basic Multilingual Plane
        strUTF8 = strUTF8 & "%" & Hex(((lngUSV \ &H1000) And &HF) Or &HE0)
        strUTF8 = strUTF8 & "%" & Hex(((lngUSV \ &H40) And &H3F) Or &H80)
        strUTF8 = strUTF8 & "%" & Hex((lngUSV And &H3F) Or &H80)
    ElseIf lngUSV > &HFFFF& And lngUSV < &H2A700 Then
        'Surrogate pairs - Supplementary Multilingual Plane.
        strUTF8 = strUTF8 & "%" & Hex(((lngUSV \ &H40000) And &H7) Or &HF0)
        strUTF8 = strUTF8 & "%" & Hex(((lngUSV \ &H1000&) And &H3F) Or &H80)
        strUTF8 = strUTF8 & "%" & Hex(((lngUSV \ &H40) And &H3F) Or &H80)
        strUTF8 = strUTF8 & "%" & Hex((lngUSV And &H3F) Or &H80)
    End If
    If IsHighSurrogate(AscW(Mid$(strIn, lngPos, 1))) Then
        lngPos = lngPos + 1
    End If
Next


UTF8_Encode = strUTF8
End Function


Public Function MakeUSV(strCharacter As String) As Long
' Makes Unicode USV value for one character.
' USV is returned as a decimal value and as a Long.
' Handles surrogate pairs.
' 4/17/2013 GZ


Dim lngHiSurr As Long 'Value of high surrogate.
Dim lngLowSurr As Long 'Value of low surrogate.


'Testing for length of 1 or 2 character. If a single character is represented
'by a surrogate pair Len() will report it's length as 2.
If LenB(strCharacter & vbNullString) <> 0 And Len(strCharacter) <= 2 Then
    If IsSurrogatePair(strCharacter) Then
        lngLowSurr = CLng("&H" & Hex$(AscW(Mid$(strCharacter, 2, 1))))
        lngHiSurr = CLng("&H" & Hex$(AscW(Left$(strCharacter, 1))))
        'From "The Unicode Standard, Version 6.0", Chapter 3, Section 7 "Surrogates".
        MakeUSV = (lngHiSurr - CLng("&HD800")) * CLng("&H400") + _
                    (lngLowSurr - CLng("&HDC00")) + CLng("&H10000")
    Else
        MakeUSV = CLng("&H" & Hex$(AscW(strCharacter)))
    End If
End If
End Function


Private Function IsSurrogatePair(txtCharacter As String) As Boolean
' Tests if a character is represented by a Unicode surrogate pair.
' Takes a single Unicode character as argument and returnes true or false.
' 4/17/2013 GZ


Dim lngHiSurr As Long


' NOTE: Len returns 2 for a single character if it is a surrogate pair.
If LenB(txtCharacter & vbNullString) <> 0 And Len(txtCharacter) <= 2 Then
    lngHiSurr = CLng("&H" & Hex$(AscW(Mid$(txtCharacter, 1, 1))))
    If Len(txtCharacter) = 2 Then
        If lngHiSurr >= &HD800& And lngHiSurr <= &HDBFF& Then
            IsSurrogatePair = True
        Else
            IsSurrogatePair = False
        End If
    Else
        IsSurrogatePair = False
    End If
End If
End Function


Public Function IsHighSurrogate(intCodePoint As Integer) As Boolean
'Returns true if code point is a Unicode high surrogate.
'4/17/2013 GZ


Const cintHighSurrLB As Integer = &HD800 'Lower bound
Const cintHighSurrUB As Integer = &HDBFF 'Upper bound


If intCodePoint >= cintHighSurrLB And intCodePoint <= cintHighSurrUB Then
    IsHighSurrogate = True
Else
    IsHighSurrogate = False
End If
End Function
 
Last edited:
Upvote 0
Hello,
following code with the function in previous post does what you are looking for .

Code:
Sub TranslateSelection()

    For r = 1 To Selection.Rows.Count
        For s = 1 To Selection.Columns.Count
           If Selection.Cells(r, s).Value <> "" Then
              Selection.Cells(r, s).Value = Translate(Selection.Cells(r, s).Value, Arabic, English)
            End If
        Next s
    Next r


End Sub


Hello,

I am new to VBA completely. I see that you have use the translation link as


translate.googleapis.com and not as translate.google.com

By using google apis will it incur cost after a certain limit?

Please advice.
 
Upvote 0
Hi All

Everything works other than the auto detect. Any clue?

Code:
Public Sub Test()' From English
Dim wksForeign As Excel.Worksheet
Dim wksResults As Excel.Worksheet
Dim rngCell As Excel.Range








Set wksForeign = Worksheets(1)

For Each rngCell In Selection 'wksForeign.Range("A1:A20")
rngCell.Offset(0, 1).Value2 = Translate(rngCell.Value2, Auto_Detect, English)
Next rngCell
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,929
Messages
6,175,451
Members
452,643
Latest member
gjcase

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