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的分享

本文使用 文章同步助手 同步