Excel打造翻译神器(自定义函数)
大家可能用过Excel本身的中英文自动翻译的函数公式,因为2013版本后增加了三个web函数,让Excel可以调用网络上的一些数据。函数公式为(其中A1为需要翻译的单元格):
=FILTERXML(WEBSERVICE("http://fanyi.youdao.com/translate?&i="&A1&"&doctype=xml&version"),"//translation")
但是公式有点长,而且翻译其他语言比较麻烦。
这时可以用自定义函数达到以下效果,不仅支持多种语言互译,而且可以对照翻译。
同时点击插入函数按钮有参数说明提示,如翻译语言可以选择以下几种:
0:简体中文 1:英文 2:法文 3:德文 4:韩文 5:日文 6:繁体中文
可以选择是否对照翻译,默认只显示译文
这是几年前分享的内容,在原来基础上增加了一些内容。
当然大家可以在我的基础上再增加一些功能,我用的是微软翻译,也能替换成有道翻译,因为微软翻译的appId每天有调用次数限制。
自定义函数代码:
Const Lib = """c:\windows\system32\user32.dll"""
Sub Auto_open() '打开工作簿时注册自定义函数说明
lang = "0:简体中文 1:英文 2:法文 3:德文 4:韩文 5:日文 6:繁体中文 "
Application.ExecuteExcel4Macro _
"REGISTER(" & Lib & ",""CharPrevA"",""PPP"",""trans"",""单元格,翻译语言,对照翻译""" _
& ",1,""单元格"",,,""文本翻译"",""翻译的内容"",""" & lang & """,""0:只显示译文 1:对照原文和译文 "")"
End Sub
Sub Auto_close() '关闭工作簿时取消自定义函数说明
Application.ExecuteExcel4Macro "UNREGISTER(""trans"")"
End Sub
Private Function trans(rng, lang, Optional contrast As Integer = 0) '
If contrast Then
chs = Split(rng, "。")
For i = 0 To UBound(chs)
If UBound(chs) > 0 And Trim(chs(i)) <> "" Then
chs(i) = chs(i) & "。"
En = Split(chs(i), ". ")
For j = 0 To UBound(En)
If UBound(En) > 0 Then En(j) = En(j) & ". "
t = t & En(j) & Chr(13) & Chr(10) & getURL(En(j), lang) & Chr(13) & Chr(10)
Next j
End If
Next i
Else
t = getURL(rng, lang)
End If
trans = t
End Function
Private Function getURL(txt, lang) '
tlang = "zh-CHS,en,fr,de,ko,ja,zh-CHT"
URL = "http://api.microsofttranslator.com/V2/Ajax.svc/Translate?oncomplete=&appId=" _
& "DF9E54CA96F73F2E289AEC059F407DE8295A6515&from=&to=" & Split(tlang, ",")(lang) & "&text=" & txt
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "get", URL, False
.Send
getURL = Replace(Mid(.ResponseText, 3, Len(.ResponseText) - 3), "\""", """")
End With
End Function
'如果appId超过当天使用量可以替换这个试试:708BEDCB01828123DC7B6C6A6AB12EF82DFBB611
下载链接:https://pan.baidu.com/s/1Hu-1oFlnYV-Eghmo0k2kSQ
提取码:bzyz
--来自百度网盘超级会员V5的分享