Excel打造翻譯神器（自定義函數(shù)）
????????大家可能用過Excel本身的中英文自動翻譯的函數(shù)公式，因為2013版本后增加了三個web函數(shù)，讓Excel可以調(diào)用網(wǎng)絡(luò)上的一些數(shù)據(jù)。函數(shù)公式為（其中A1為需要翻譯的單元格）：?
=FILTERXML(WEBSERVICE("http://fanyi.youdao.com/translate?&i="&A1&"&doctype=xml&version"),"//translation")
? ?????但是公式有點長，而且翻譯其他語言比較麻煩。
????? 這時可以用自定義函數(shù)達(dá)到以下效果，不僅支持多種語言互譯，而且可以對照翻譯。
??????
同時點擊插入函數(shù)按鈕有參數(shù)說明提示，如翻譯語言可以選擇以下幾種：
0:簡體中文? 1:英文? 2:法文? 3:德文? 4:韓文? 5:日文? 6:繁體中文
可以選擇是否對照翻譯，默認(rèn)只顯示譯文
這是幾年前分享的內(nèi)容，在原來基礎(chǔ)上增加了一些內(nèi)容。
當(dāng)然大家可以在我的基礎(chǔ)上再增加一些功能，我用的是微軟翻譯，也能替換成有道翻譯，因為微軟翻譯的appId每天有調(diào)用次數(shù)限制。
自定義函數(shù)代碼：
Const Lib = """c:\windows\system32\user32.dll"""
Sub Auto_open()? ? ?'打開工作簿時注冊自定義函數(shù)說明
? ? lang = "0:簡體中文? 1:英文? 2:法文? 3:德文? 4:韓文? 5:日文? 6:繁體中文? "
? ? application.ExecuteExcel4Macro _
? ? "REGISTER(" & Lib & ",""CharPrevA"",""PPP"",""trans"",""單元格,翻譯語言,對照翻譯""" _
? ? & ",1,""單元格"",,,""文本翻譯"",""翻譯的內(nèi)容"",""" & lang & """,""0:只顯示譯文? 1:對照原文和譯文? "")"
End Sub
Sub Auto_close()? ? '關(guān)閉工作簿時取消自定義函數(shù)說明
? ? 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超過當(dāng)天使用量可以替換這個試試：708BEDCB01828123DC7B6C6A6AB12EF82DFBB611
下載鏈接：https://pan.baidu.com/s/1Hu-1oFlnYV-Eghmo0k2kSQ
提取碼：bzyz
--來自百度網(wǎng)盤超級會員V5的分享
本文使用 文章同步助手 同步
