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

哎哟喂先森

不喜欢有道翻译或者百度翻译的小伙伴可以看一下
能下拉批量翻译，需要联网，稍微更改代码能实英文翻译为其它语言。
中译英暂时还没调试好，能实现中译英的小伙伴可以告诉我！
效果如图



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
    url = "https://translate.google.cn/m?hl=en&sl=enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & rng
    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

程然2234

楼主上传附件看看

哎哟喂先森

程然2234 发表于 2019-11-19 15:13
楼主上传附件看看

你直接复制代码就好了

程然2234

哎哟喂先森 发表于 2019-11-19 16:43
你直接复制代码就好了

复制代码运行没有反应的

YZC51

跟学习下。谢谢老师！
Public Function EnToCh(rng As String, z)
    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
    If z = 1 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
            GetURL1 = Application.Hex2Bin(left(Hex(AscW(txt1)), 2), 8)
            GetURL1 = GetURL1 & Application.Hex2Bin(right(Hex(AscW(txt1)), 2), 8)
            GetURL1 = Application.Replace(Application.Replace(GetURL1, 11, , 10), 5, , 10)
            GetURL2 = "%E" & Application.Bin2Hex(left(GetURL1, 4))
            GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 5, 8))
            GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 13, 8))
            GetURL = GetURL & GetURL2
        End If
    Next
End Function

YZC51

请参考
中英文互译.rar (15.1 KB, 下载次数: 1267)

2019-11-20 20:38 上传

点击文件名下载附件

YZC51

优化下
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

YZC51

6楼附件， 中英文互译啦

哎哟喂先森

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

牛逼牛逼。。我终于知道原因了

哎哟喂先森

楼上可真棒！