VBA 上的 Google Translate API 的 Mojibake 问题Excel 2010

编程问答 2022-05-14

问题描述

我正在使用下面的 VBA 函数通过 Google Translate 翻译选定的单元格。

它工作正常，但存在以下问题：

  1. 符号/表情符号：当文本中有符号或表情符号时，无法正确返回。例如：

☀早上好，你好吗？ ☀

返回

  • Bonjour，评论 vas-tu？ â€

我猜这是一个编码问题，但我无法修复它。

  1. 换行符：原始文本中的换行符不保留在返回的翻译中。正如您在代码中看到的，我必须用占位符替换原始文本中的每个换行符，然后在翻译文本中再次将其替换回来。有没有更有效的方法来保存它们？

我使用的是 Excel 2010 64 位。

提前致谢。

Sub GoogleTranslate()
    Dim getParam As String,trans As String,translateFrom As String,translateto As String

    translateFrom = "en"

    translateto = "fr"
    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    Dim r As Range,cell As Range
    Set cell = Selection
    For Each cell In Selection.Cells
    If Not (cell.EntireRow.Hidden Or IsEmpty(cell)) Then
        getParam = ConvertToGet(cell.Value)
        URL = "https://translate.google.com/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>")
            cell.Value = Clean(trans)
        Else
            cell.Value = Clean(CStr(Split(Split(objHTTP.responsetext,"<div class=""result-container"">")(1),"</div>")(0)))
            cell.Interior.Color = RGB(255,0)
            cell.Font.Color = Black
            cell.ClearComments
        End If
        End If
    Next cell
End Sub
 
Function ConvertToGet(val As String)
    val = Replace(val,"%","%25")
    val = Replace(val," ","+")
    val = Replace(val,vbNewLine,"(","%28")
    val = Replace(val,")","%29")
    val = Replace(val,"&","and")
    val = Replace(val,"#","%23")
    val = Replace(val,vbLf,"<xxx>")  'linebreak workaround
    ConvertToGet = val
End Function

Function Clean(val As String)
    val = Replace(val,"&quot;","""")
    val = Replace(val,"%2C",",")
    val = Replace(val,"&#39;","'")
    val = Replace(val,"&lt;","<")
    val = Replace(val,"&gt;",">")
    val = Replace(val," <xxx> ",vbLf)  'linebreak workaround
    val = Replace(val," <xxx>","<xxx> ","<xxx>","")  'linebreak workaround
    Clean = val
End Function

Public Function RegexExecute(str As String,reg As String,_
                             Optional matchIndex As Long,_
                             Optional subMatchIndex As Long) As String
    On Error GoTo ErrHandl
    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
ErrHandl:
    RegexExecute = CVErr(xlErrValue)
End Function

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

excel-2010google-translateunicodevba