分享EXCEL批量英译中谷歌翻译，无需安装插件即可实现

YZC51

再精简下
Public Function EnToCh(rng As String)
    Dim xml
    Dim URL$, EngSentence$
    Set xml = CreateObject("MSXML2.XMLHTTP")
    aasc = Asc(rng)
    If aasc > 64 And aasc < 123 Then
        URL = "enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & rng
    Else
        URL = "zh-CN&tl=enN&ie=UTF-8&prev=_m&q=" & GetURL(rng)
    End If
    URL = "https://translate.google.cn/m?hl=en&sl=" & URL
    With xml
        .Open "GET", URL, False
        .send
        V = .responseText
        If InStr(V, "t0"">") > 0 Then
            EnToCh = Split(Split(V, "t0"">")(1), "<")(0)
        End If
    End With
End Function

oneflag

请教大师：请问日文转中文怎么改

shinying

牛B PLUS !真好

summeren

oneflag 发表于 2019-11-21 14:26
请教大师：请问日文转中文怎么改

中文翻译日文，改一下就可以了；  URL = "https://translate.google.cn/m?hl=ja&sl=zh-CN&tl=jaN&ie=UTF-8&prev=_m&q=" & GetURL(rng)

aman1516

同时调整用语音，主可作点读机了

summeren

YZC51 发表于 2019-11-20 20:40
优化下
Public Function EnToCh(rng As String)
    Dim xml

大佬 这个互译 i'm 会变成i&#;m  ,你可以试试翻译：我要去超市；

ahxiAdong

膜拜一下大神！

YZC51

summeren 发表于 2019-12-19 21:35
大佬 这个互译 i'm 会变成i&#;m  ,你可以试试翻译：我要去超市；

老师好！谢谢您提醒！代码修改rux：
Public Function EnToCh(Rng As String)
    Dim xml
    Dim URL$, EngSentence$
    Set xml = CreateObject("MSXML2.XMLHTTP")
    aasc = Asc(Rng)
    If aasc > 64 And aasc < 123 Then
        URL = "enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & Rng
    Else
        URL = "zh-CN&tl=enN&ie=UTF-8&prev=_m&q=" & GetURL(Rng)
    End If
    URL = "https://translate.google.cn/m?hl=en&sl=" & URL
    With xml
        .Open "GET", URL, False
        .send
        V = .responseText
'        Debug.Print V &#39;
        If InStr(V, "t0"">") > 0 Then
            EnToCh = Replace(Split(Split(V, "t0"">")(1), "<")(0), "&#39;", "'")
        End If
    End With
End Function

tianyk

下载学习，收藏啦

weiyingde

YZC51 发表于 2019-11-20 20:42
6楼附件， 中英文互译啦

老师好，我想把它引入word 模板中，红字的地方作修改（不修改显然不能运行）
却出现乱码：
Public Function EnToCh(rng As String)
    Dim xml
    Dim url$, EngSentence$
    Set xml = CreateObject("MSXML2.XMLHTTP")
   'EngSentence = URLEncodePlus(rng.Text)
   'url = "https://translate.google.cn/m?hl=en&sl=enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & EngSentence
    'Debug.Print Asc(rng)
    aasc = Asc(rng)
    If aasc > 64 And aasc < 123 Then
        url = "https://translate.google.cn/m?hl=en&sl=enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & rng
    Else
        url = "https://translate.google.cn/m?hl=en&sl=zh-CN&tl=enN&ie=UTF-8&prev=_m&q=" & GetURL(rng)
    End If
    With xml
      .Open "GET", url, False
      .send
       If InStr(.responseText, "<div dir=""ltr"" class=""t0"">") > 0 Then
            EnToCh = Split(Split(.responseText, "<div dir=""ltr"" class=""t0"">")(1), "</div><")(0)
        End If
    End With
End Function
Function GetURL$(txt$)
'Dim a() As Byte
'a = StrConv(txt, vbFromUnicode, &H804)
    For i = 1 To Len(txt)
        txt1 = Mid(txt, i, 1)
        If Abs(Asc(txt1)) < 128 Then
            GetURL = GetURL & txt1
        Else
            With Excel.Application.WorksheetFunction
                 GetURL1 = .Hex2Bin(Left(Hex(AscW(txt1)), 2), 8)
                 GetURL1 = GetURL1 & .Hex2Bin(Right(Hex(AscW(txt1)), 2), 8)
                 GetURL1 = VBA.Replace(VBA.Replace(GetURL1, 11, 10), 5, 10)
               '因为不能运行，
                 GetURL2 = "%E" & .Bin2Hex(Left(GetURL1, 4))
                 GetURL2 = GetURL2 & "%" & .Bin2Hex(Mid$(GetURL1, 5, 8))
                 GetURL2 = GetURL2 & "%" & .Bin2Hex(Mid$(GetURL1, 13, 8))
                 GetURL = GetURL & GetURL2
            End With
        End If
    Next
End Function
'如果一律转码是: GetURL = GetURL & "%" & Right("0" & Hex(a(i)), 2)
Sub 测试()
MsgBox EnToCh("中国")
End Sub
你看看是不是出现乱码，不知是什么原因。
请指点，谢谢你。