EXCEL GOOGLE翻译功能 问题

976190982

事情是这样的，我是搞外贸的，最近搞了一个品牌，需要中文翻译英文，无奈想找一个好点的翻译代码，于是找我朋友，朋友扔过来，他也不懂，实在是没法了，于是向老师们请教。


translateFrom = "zh"  源语言
translateTo = "en" 目标语言      实测定义好后，其余不需要修改

1. Sub TranslateCell()
   
2.     Dim getParam As String, trans As String, translateFrom As String, translateTo As String
   
3.     translateFrom = "zh"
   
4.     translateTo = "en"
   
5.     Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
   
6.     Dim r As Range, cell As Range
   
7.     Set cell = Selection
   
8.     For Each cell In Selection.Cells
   
9.         getParam = ConvertToGet(cell.Value)
   
10.         URL = "https://translate.google.cn/m?hl=" & translateFrom & "&sl=" & translateFrom & "&tl=" & translateTo & "&ie=UTF-8&prev=_m&q=" & getParam
    
11.         objHTTP.Open "GET", URL, False
    
12.         objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    
13.         objHTTP.send ("")
    
14.         If InStr(objHTTP.responseText, "div dir=""ltr""") > 0 Then
    
15.             trans = RegexExecute(objHTTP.responseText, "div[^""]*?""ltr"".*?>(.+?)</div>")
    
16.             cell.Value = Clean(trans)
    
17.         Else
    
18.             MsgBox ("Error")
    
19.         End If
    
20.     Next cell
    
21. End Sub
    
22. 
    
23. 
    
24. Function ConvertToGet(val As String)
    
25.     val = Replace(val, " ", "+")
    
26.     val = Replace(val, vbNewLine, "+")
    
27.     val = Replace(val, "(", "%28")
    
28.     val = Replace(val, ")", "%29")
    
29.     ConvertToGet = val
    
30. End Function
    
31. 
    
32. Function Clean(val As String)
    
33.     val = Replace(val, """, """")
    
34.     val = Replace(val, "%2C", ",")
    
35.     val = Replace(val, "'", "'")
    
36.     Clean = val
    
37. End Function
    
38. 
    
39. Public Function RegexExecute(str As String, reg As String, _
    
40.                              Optional matchIndex As Long, _
    
41.                              Optional subMatchIndex As Long) As String
    
42.     On Error GoTo ErrHandl
    
43.     Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = reg
    
44.     regex.Global = Not (matchIndex = 0 And subMatchIndex = 0) 'For efficiency
    
45.     If regex.Test(str) Then
    
46.         Set matches = regex.Execute(str)
    
47.         RegexExecute = matches(matchIndex).SubMatches(subMatchIndex)
    
48.         Exit Function
    
49.     End If
    
50. ErrHandl:
    
51.     RegexExecute = CVErr(xlErrValue)
    
52. End Function
    

复制代码

我测试的结果如下


1、会被封ip，太多次就会。
2、使用方式是 先选取要翻译的区域然后运行TranslateCell，即可，但是太多了，会被封掉，求老师们帮忙瞅一下，麻烦了
3、另附一个问题，我需要翻译的数据放在A列，翻译结果放在B列，求老师们帮忙改，对于做外贸的我，这个实在是刚需啊。求老师们帮助。
翻译.zip (13.85 KB, 下载次数: 33)

2020-8-25 15:54 上传

点击文件名下载附件

在此感谢经常帮助我的老师，@liulang0808   @chxw68   @一把小刀闯天下，还有其余跟多老师，在此就不提名了，谢谢你们，也谢谢这个论坛。

我费劲心思找到了原网站https://analystcave.com/excel-google-translate-functionality/

由于是国外的网站我准备了图片，希望能帮到老师们
图片上传后不清晰，麻烦老师们下载图片附件 Excel Google Translate functionality - Analyst Cav.zip (598.44 KB, 下载次数: 27)

2020-8-25 20:17 上传

点击文件名下载附件

老师们，我在论坛找到了相关的文档，是自定义公式版本，但是没有VBA版本的，（因实际需要中，是一个宏里面也是之前老师帮助写的，所以想跟那个宏一起同步使用）所以想求老师们帮助改成指定区域循环的，本人功力浅薄，只能求助于老师们。
http://club.excelhome.net/thread-1508743-2-1.html

代码如下：

1. Public Function EnToCh(Rng As String)
   
2.     Dim xml
   
3.     Dim URL$, EngSentence$
   
4.     Set xml = CreateObject("MSXML2.XMLHTTP")
   
5.     aasc = Asc(Rng)
   
6.     If aasc > 64 And aasc < 123 Then
   
7.         URL = "enN&tl=zh-CN&ie=UTF-8&prev=_m&q=" & Rng
   
8.     Else
   
9.         URL = "zh-CN&tl=enN&ie=UTF-8&prev=_m&q=" & GetURL(Rng)
   
10.     End If
    
11.     URL = "https://translate.google.cn/m?hl=en&sl=" & URL
    
12.     With xml
    
13.         .Open "GET", URL, False
    
14.         .send
    
15.         V = .responseText
    
16. '        Debug.Print V '
    
17.         If InStr(V, "t0"">") > 0 Then
    
18.             EnToCh = Replace(Split(Split(V, "t0"">")(1), "<")(0), "'", "'")
    
19.         End If
    
20.     End With
    
21. End Function
    
22. 
    
23. Function ChrU(txt)
    
24.     txt = "\u6666" & txt
    
25.     sr = Split(txt, "\u") '按汉字单位拆分
    
26.     For i = 0 To UBound(sr) '遍历
    
27.         If Len(sr(i)) > 3 Then sr(i) = ChrW("&H" & Left(sr(i), 4)) & Mid(sr(i), 5)
    
28.         '如果4个字符以上 则取前4个字符(汉字的16进制国际双位码值) 添加"&H"转为16进制数
    
29.      '然后用ChrW函数即可返回汉字
    
30.     Next
    
31.     ChrU = Mid(Join(sr, ""), 2) '把转换后的汉字以及其余字符合并起来返回
    
32. End Function
    
33. 
    
34. Function sjc$() '时间戳
    
35. 'sjc = (Now - 25569 - 1 / 3) * 86400
    
36. sjc = (Now - 25570 + 2 / 3) * 86400 + 100
    
37. sjc = "=" & Left(sjc & Rnd * 100000, 13)
    
38. 'Debug.Print sjc
    
39. End Function
    
40. 
    
41. Function GetURL$(txt$)
    
42. 'Dim a() As Byte
    
43. 'a = StrConv(txt, vbFromUnicode, &H804)
    
44.     For i = 1 To Len(txt)
    
45.         txt1 = Mid(txt, i, 1)
    
46.         If Abs(Asc(txt1)) < 128 Then
    
47.             GetURL = GetURL & txt1
    
48.         Else
    
49.             GetURL1 = Application.Hex2Bin(Left(Hex(AscW(txt1)), 2), 8)
    
50.             GetURL1 = GetURL1 & Application.Hex2Bin(Right(Hex(AscW(txt1)), 2), 8)
    
51.             GetURL1 = Application.Replace(Application.Replace(GetURL1, 11, , 10), 5, , 10)
    
52.             GetURL2 = "%E" & Application.Bin2Hex(Left(GetURL1, 4))
    
53.             GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 5, 8))
    
54.             GetURL2 = GetURL2 & "%" & Application.Bin2Hex(Mid$(GetURL1, 13, 8))
    
55.             GetURL = GetURL & GetURL2
    
56.         End If
    
57.     Next
    
58. End Function
    
59. '如果一律转码是: GetURL = GetURL & "%" & Right("0" & Hex(a(i)), 2)
    
60. 
    

复制代码

976190982

老师们，求帮助啊，自顶一波

qcw911

谷歌翻译，有道翻译，百度翻译都行？

tspliu

如果懂一点VBA，自己看百度翻译的API技术文档。不懂用就python,他给提供写好了的。

976190982

qcw911 发表于 2020-8-26 16:33
谷歌翻译，有道翻译，百度翻译都行？

有道翻译不准确

976190982

tspliu 发表于 2020-8-26 16:49
如果懂一点VBA，自己看百度翻译的API技术文档。不懂用就python,他给提供写好了的。

谢谢回复    我正在参考

1055751654

搞外贸的不是自己可以翻译吗？还要借助翻译呀

976190982

1055751654 发表于 2020-8-26 20:30
搞外贸的不是自己可以翻译吗？还要借助翻译呀

没办法啊  手工翻译 数据也特多了

tspliu

976190982 发表于 2020-8-26 20:23
谢谢回复    我正在参考

我是用的华为云里的各种识别功能（主要是ocr），我也不会写，都直接下载的华为提供的SDK,把参数修改成自己的，然后把得到的JSON格式数据转换成表格需要的样式就行了

ExcelAPInet

用Excel进行翻译，VBA代码虽然可以处理http请求，但现在谷歌的http请求链接用限制，翻译不了多少。我们现在开发了一个翻译函数GoogleTranslateByWebBrowser()，借助浏览器调用谷歌翻译网页，还能批量翻译，这样就不受限，除了谷歌，还有百度、有道、微软、DeepL、阿里云翻译等。