[VBA][PowerPoint] Translate selected text in slide using Google Translate.

GGTranslatePPT.vba

Function Translate(SText As String, Optional FromLang As String = "0", Optional ToLang As String = "th") As String
    ' Translate text using Google Translate
    Dim p1&, p2&, URL$, resp$, d1$, result
    Dim xmlhttp As New MSXML2.XMLHTTP60 'Must add references (Tools>References) Microsoft XML v 6.0
    
    Const URL_TEMPLATE$ = "https://translate.google.co.th/m?sl=[from]&tl=[to]&hl=[from]&q="
    Const DIV_RESULT$ = "<div class=""result-container"">"
    URL = URL_TEMPLATE & URLEncode(SText)
    URL = Replace(URL, "[to]", ToLang)
    URL = Replace(URL, "[from]", FromLang)
    xmlhttp.Open "GET", URL, False
    xmlhttp.Send
    resp = xmlhttp.responseText
    'Debug.Print resp
    p1 = InStr(resp, DIV_RESULT)
    If p1 > 0 Then
        p1 = p1 + Len(DIV_RESULT)
        p2 = InStr(p1, resp, "</div>")
        result = Mid(resp, p1, p2 - p1)
        Translate = GGClean(CStr(result))
    End If
        
End Function
Function URLEncode(ByRef txt As String) As String
    Dim buffer As String, i As Long, c As Long, n As Long
    buffer = String$(Len(txt) * 12, "%")
 
    For i = 1 To Len(txt)
        c = AscW(Mid$(txt, i, 1)) And 65535
 
        Select Case c
            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95  ' Unescaped 0-9A-Za-z-._ '
                n = n + 1
                Mid$(buffer, n) = ChrW(c)
            Case Is <= 127            ' Escaped UTF-8 1 bytes U+0000 to U+007F '
                n = n + 3
                Mid$(buffer, n - 1) = Right$(Hex$(256 + c), 2)
            Case Is <= 2047           ' Escaped UTF-8 2 bytes U+0080 to U+07FF '
                n = n + 6
                Mid$(buffer, n - 4) = Hex$(192 + (c \ 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            Case 55296 To 57343       ' Escaped UTF-8 4 bytes U+010000 to U+10FFFF '
                i = i + 1
                c = 65536 + (c Mod 1024) * 1024 + (AscW(Mid$(txt, i, 1)) And 1023)
                n = n + 12
                Mid$(buffer, n - 10) = Hex$(240 + (c \ 262144))
                Mid$(buffer, n - 7) = Hex$(128 + ((c \ 4096) Mod 64))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
            Case Else                 ' Escaped UTF-8 3 bytes U+0800 to U+FFFF '
                n = n + 9
                Mid$(buffer, n - 7) = Hex$(224 + (c \ 4096))
                Mid$(buffer, n - 4) = Hex$(128 + ((c \ 64) Mod 64))
                Mid$(buffer, n - 1) = Hex$(128 + (c Mod 64))
        End Select
    Next
    URLEncode = Left$(buffer, n)
End Function

Sub TETranslate()
'Translate selection text to English
With ActiveWindow.Selection.TextRange
    .Text = Translate(ActiveWindow.Selection.TextRange.Text, , "en")
End With

End Sub

Sub ETTranslate()
'Translate selection text to Thai
With ActiveWindow.Selection.TextRange
    .Text = Translate(ActiveWindow.Selection.TextRange.Text, , "th")
End With
End Sub

Function GGClean(inText As String)
Dim result As String
result = Replace(inText, "&#39;", "'")
result = Replace(result, "&quot;", """")
result = Replace(result, "%2C", ",")
GGClean = result
End Function