EXCEL VBA调用百度API翻译_vba代码翻译器在线

EXCEL VBA调用百度API翻译

Public Function translateZh_En(ByVal str As String) As String
   '调用百度翻译API，将指定内容由中文翻译为英文
    Dim par As String
    Dim data() As String
    par = generateReqStr(str, "zh", "en")
    data() = translateJson(getHttp(par)) '调用API,获取API 返回, '调用JSON转换函数，解析API返回的结果
'    Debug.Print data(0)
'    Debug.Print data(1)
'    Debug.Print data(2)
'    Debug.Print data(3)
'    Debug.Print data(4)
'    Debug.Print data(5)
    translateZh_En = UCase(data(3)) '获取API返回的翻译结果
End Function
Public Function translateZh_En_Batch(ByRef arr() As String) As String()
   '调用百度翻译API，将指定内容由中文翻译为英文
    Dim par As String
    Dim data() As String
    Dim returnData() As String
    Dim resp As String
    par = generateReqStrBatch(arr, "zh", "en")
    resp = getHttp(par)  '调用API,获取API 返回
    data() = translateJsonBatch(resp) '调用JSON转换函数，解析API返回的结果
    ReDim returnData(UBound(data) - 4) As String
    For i = 0 To UBound(data) - 4
        returnData(i) = UCase(Split(data(i), "|", -1, vbTextCompare)(1))
    translateZh_En_Batch = returnData() '获取API返回的翻译结果
End Function
Public Function translateEn_Zh(ByVal str As String) As String
    '调用百度翻译API，将指定内容由英文翻译为中文
    Dim par As String
    Dim data() As String
    par = generateReqStr(str, "en", "zh")
    data() = translateJson(getHttp(par)) '调用API,获取API 返回, '调用JSON转换函数，解析API返回的结果
    translateEn_Zh = data(3)
End Function
Public Function translateEn_Zh_Batch(ByRef arr() As String) As String()
   '调用百度翻译API，将指定内容由英文翻译为中文
    Dim par As String
    Dim data() As String
    Dim returnData() As String
    Dim resp As String
    par = generateReqStrBatch(arr, "en", "zh")
    resp = getHttp(par)  '调用API,获取API 返回
    data() = translateJsonBatch(resp) '调用JSON转换函数，解析API返回的结果
    ReDim returnData(UBound(data) - 4) As String
    For i = 0 To UBound(data) - 4
        returnData(i) = Split(data(i), "|", -1, vbTextCompare)(1)
    translateZh_En_Batch = returnData() '获取API返回的翻译结果
End Function
Public Function getHttpOld(str As String) As String
'调用API
Dim HttpReq As Object
Dim url As String
Set HttpReq = CreateObject("Microsoft.XMLHTTP") '创建XMLHTTP对象
url = "http://openapi.baidu.com/public/2.0/bmt/translate?client_id=iOMhRqTKNByhC80V9SbcQIpo&" & str
With HttpReq
        .Open "GET", url, False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded"
        .SEND
        'Debug.Print .responsetext
End With
'发送HTTL  Get请求， 百度API只允许GET，不允许POST
getHttp = HttpReq.responsetext
End Function
Public Function getHttp(str As String) As String
'调用API（new）
Dim HttpReq As Object
Dim url As String
Set HttpReq = CreateObject("Microsoft.XMLHTTP") '创建XMLHTTP对象
url = "http://api.fanyi.baidu.com/api/trans/vip/translate?" & str
'Debug.Print (url)
With HttpReq
        .Open "GET", url, False
        .setRequestHeader "content-type", "application/x-www-form-urlencoded"
        .SEND
        'Debug.Print .responsetext
End With
'发送HTTL  Get请求， 百度API只允许GET，不允许POST
getHttp = HttpReq.responsetext
End Function
Public Function generateReqStr(q As String, from_Str As String, to_Str As String) As String
'生成Request 字符串
    Dim appid As String
    Dim key As String
    Dim salt As Integer
    Dim sign As String
    Dim par As String
    Math.Randomize (Timer)
    salt = (Rnd * 1000000) Mod 20000
    key = "修改为你自己申请的API的Key"
    appid = "修改为你自己申请的API的appid"
    'Debug.Print (appid + q + CStr(salt) + key)
    sign = MD5_32(appid + q + CStr(salt) + key)  '转换为MD5
    'Debug.Print (sign)
    par = "q=" + encode(q) + "&from=" + from_Str + "&to=" + to_Str + "&appid=" + appid + "&salt=" + CStr(salt) + "&sign=" + sign  '调用urlencode 方法，将待翻译内容转换为urlencode,
    generateReqStr = par
End Function
Public Function generateReqStrBatch(q() As String, from_Str As String, to_Str As String) As String
'生成Request 字符串
    Dim appid As String
    Dim key As String
    Dim salt As Integer
    Dim sign As String
    Dim par As String
    Dim str1 As String
    'Dim ln As String
    'ln = ChrB(10) & ChrB(0)
    Math.Randomize (Timer)
    salt = (Rnd * 1000000) Mod 20000
    key = "修改为你自己申请的API的Key"
    appid = "修改为你自己申请的API的appid"
    For i = LBound(q) To UBound(q)
        str1 = str1 & q(i) & vbLf
    'Debug.Print (appid + str1 + CStr(salt) + key)
    sign = MD5_32(appid + str1 + CStr(salt) + key)  '转换为MD5
    'Debug.Print (sign)
    par = "q=" + encode(str1) + "&from=" + from_Str + "&to=" + to_Str + "&appid=" + appid + "&salt=" + CStr(salt) + "&sign=" + sign '调用urlencode 方法，将待翻译内容转换为urlencode,
    generateReqStrBatch = par
End Function
Public Function translateJson(str As String) As String()
'调用JScript 解析JSON
Dim js As Object
Dim objJSON As Object
Dim objJSON2 As Object
Dim strFunc As String
Dim returnData(6) As String
'创建Script对象
Set js = CreateObject("ScriptControl"): js.Language = "JScript"
'aa = "{""from"":""en"",""to"":""zh"",""trans_result"":[{""src"":""today"",""dst"":""\u4eca\u5929""}]}"
'获取第一层的数据内容的JavaScript函数代码
strFunc = "function getjson(s) { return eval('(' + s + ')'); }"
'获取第二层的数据内容JavaScript函数代码
strFunc2 = "function j(s) { return eval('(' + s + ').trans_result[0]'); }"
'将JavaScript函数代码加入到Script对象。
js.AddCode strFunc
js.AddCode strFunc2
Set objJSON = js.CodeObject.getjson(str) '执行函数方法 ,这是一种执行方法
On Error GoTo ErrorHandler1
Set objJSON2 = js.Run("j", str)   '执行函数方法 ,这是另一种执行方法
'获取第一层的结果
'Debug.Print objJSON.from
'Debug.Print objJSON.to
'Debug.Print objJSON.trans_result
returnData(0) = objJSON.from
'returnData(1) = objJSON.To
'获取第二层的结果
'Debug.Print CallByName(objJSON2, "src", VbGet)  '这是另一种获取属性的方法
'Debug.Print objJSON2.dst
returnData(2) = objJSON2.src
returnData(3) = objJSON2.dst
'如果API执行结果不正确，获取API的不正确的返回信息。
On Error GoTo ErrorHandler
returnData(4) = objJSON.error_code
returnData(5) = objJSON.error_msg
translateJson = returnData
Exit Function
ErrorHandler:
returnData(4) = ""
returnData(5) = ""
translateJson = returnData
Exit Function
ErrorHandler1:
returnData(0) = ""
returnData(1) = ""
returnData(2) = ""
returnData(3) = ""
returnData(4) = objJSON.error_code
returnData(5) = objJSON.error_msg
translateJson = returnData
Exit Function
End Function
Public Function translateJsonBatch(str As String) As String()
'调用JScript 解析JSON
Dim js As Object
Dim objJSON As Object
Dim objJSON2 As Object
Dim count As String
Dim count_i As Integer
Dim strFunc As String
Dim returnData(6) As String
Dim returnData2() As String
'创建Script对象
Set js = CreateObject("ScriptControl"): js.Language = "JScript"
'aa = "{""from"":""en"",""to"":""zh"",""trans_result"":[{""src"":""today"",""dst"":""\u4eca\u5929""}]}"
'获取第一层的数据内容的JavaScript函数代码
strFunc = "function getjson(s) { return eval('(' + s + ')'); }"
'获取第二层的数据个数JavaScript函数代码
strFunc1 = "function getjsonCount(s) { return eval('(' + s + ').trans_result.length'); }"
'获取第二层的数据内容JavaScript函数代码
strFunc2 = "function getjsonLevel(s,i) { return eval('(' + s + ').trans_result['+i+']'); }"
'将JavaScript函数代码加入到Script对象。
js.AddCode strFunc
js.AddCode strFunc1
js.AddCode strFunc2
On Error GoTo ErrorHandler2
Set objJSON = js.CodeObject.getjson(str) '执行函数方法 ,这是一种执行方法
On Error GoTo ErrorHandler1
count = js.CodeObject.getjsonCount(str) '获取数据个数
returnData(0) = objJSON.from
'returnData(1) = objJSON.To
count_i = Val(count)
If (count > 0) Then
    ReDim returnData2(count + 3) As String
'Set objJSON2 = js.Run("j", str)   '执行函数方法 ,这是另一种执行方法
returnData2(UBound(returnData2) - 3) = returnData(0)
returnData2(UBound(returnData2) - 2) = returnData(1)
    For i = 0 To count - 1  '获取返回的数组内容
        Set objJSON2 = js.CodeObject.getjsonLevel(str, i)
        returnData(2) = objJSON2.src
        returnData(3) = objJSON2.dst
        returnData2(i) = returnData(2) & "|" & returnData(3)
   ReDim returnData2(4) As String  '无数据返回，则数据区域返回空
   returnData2(0) = " | "
End If
'如果API执行结果不正确，获取API的不正确的返回信息。
On Error GoTo ErrorHandler
'returnData(4) = objJSON.error_code
'returnData(5) = objJSON.error_msg
returnData2(UBound(returnData2) - 1) = returnData(4)
returnData2(UBound(returnData2)) = returnData(5)
translateJsonBatch = returnData2
Exit Function
ErrorHandler:
'获取错误信息失败，则设置错误信息为空
returnData(4) = ""
returnData(5) = ""
returnData2(UBound(returnData2) - 1) = returnData(4)
returnData2(UBound(returnData2)) = returnData(5)
translateJsonBatch = returnData2
Exit Function
ErrorHandler1: '获取第一层数据失败，则返回错误信息
returnData(0) = ""
returnData(1) = ""
returnData(2) = ""
returnData(3) = ""
returnData(4) = objJSON.error_code
returnData(5) = objJSON.error_msg
ReDim returnData2(4) As String  '无数据返回，则数据区域返回空
returnData2(UBound(returnData2) - 3) = returnData(0)
returnData2(UBound(returnData2) - 2) = returnData(1)
returnData2(UBound(returnData2) - 1) = returnData(4)
returnData2(UBound(returnData2)) = returnData(5)
returnData2(0) = " | "
translateJsonBatch = returnData2
Exit Function
ErrorHandler2: '获取第一层数据失败，则返回错误信息
   ReDim returnData2(4) As String  '无数据返回，则数据区域返回空
   returnData2(0) = " | "
translateJsonBatch = returnData2
Exit Function
End Function
Public Function encode(ByVal str As String) As String
'调用JavaScript的encodeURIComponent方法进行urlencode 编码
   Dim js As Object
   Dim strFun As String
   Dim data As String
   Set js = CreateObject("ScriptControl"): js.Language = "JScript"
     'aa = "{""from"":""en"",""to"":""zh"",""trans_result"":[{""src"":""today"",""dst"":""\u4eca\u5929""}]}"
    strFunc = "function getjson(s) { return eval('encodeURIComponent(\""'+s+'\"")'); }"
    js.AddCode strFunc
    str = Replace(str, vbCrLf, "\r\n")  '转换回车换行符为URL回车换行符
    str = Replace(str, vbLf, "\n")   '转换换行符为URL换行符
   data = js.CodeObject.getjson(str)
   'Debug.Print data
   encode = data
End Function
Sub testTranslate()
    Debug.Print translateZh_En("感觉身体被掏空")
    Dim testData() As String
    ReDim testData(5)
    testData(0) = "苹果"
    testData(1) = "香蕉"
    testData(2) = "不作就不会死"
    testData(3) = "红色"
    testData(4) = "绿色"
    testData(5) = "黄色"
    Dim returnData() As String
    returnData = translateZh_En_Batch(testData)
    For i = 0 To UBound(returnData)
        Debug.Print returnData(i)
End Sub
Public Function FY(ByVal 语句 As String, Optional 源语言 As String = "zh", Optional 目标语言 As String = "en") As String
    Dim par As String
    Dim data() As String
    par = generateReqStr(语句, LCase(源语言), LCase(目标语言))
    data() = translateJson(getHttp(par))
    FY = LCase(data(3))
End Function
				在Excel中会进行一些文本翻译的操作，那么有时遇到excel不自带翻译的功能，就算带有翻译，也只能中文翻译成英文，英文翻译成中文，翻译成其他的语言根本翻译不出来。Excel的版本不一样，微软的Excel自带翻译，wps的没有其他语言的翻译功能，那么如何解决呢，根据下方地址就能解决你所要解决的问题。
地址：http://club.excelhome.net/forum.php?mod=viewthread&tid=1389626
For di = 1 To Range("d65536 ").End(xlUp).Row     '遍历到d列有信心的最后一列
    If Range("d" & di) = Empty Then  '如果中间有空的列则跳过
        Set rng = Ra
//源自http://translate.google.cn/
TKK=eval('((function(){var a\x3d618632403;var b\x3d1485484074;return 412204+\x27.\x27+(a+b)})())');
//会变动
//源自http://translate.google.cn/translate/rel...
				本文是为了科普和演示如何将VBA代码翻译成python调用的形式：
VBA代码翻译成Python调用示例
下面这段拆分Excel表的vba代码来自才哥的文章《Python对比VBA实现excel表格合并与拆分》，作者“两百斤的老涛”：
Sub 表格拆分()
    '屏幕刷新=false
    Application.ScreenUpdating = False
    Dim LastRow, LastCol As Long
    Dim Sh, Sht As Worksheet
    'Sh指代当
1. 首先，确保您的计算机已安装了金蝶云星空的开发工具包（SDK）并进行了正确的配置。
2. 在Excel中，按下“ALT+F11”键，打开Visual Basic for Applications（VBA）编辑器。
3. 在VBA编辑器中，导航到“工具”菜单，选择“引用”。
4. 在“引用”对话框中，选择“浏览”，然后找到并选择金蝶云星空的SDK安装目录。
5. 在SDK安装目录中，找到并选择对应的API接口文件，通常是一个名为“Kingdee.BOS.WebApi.Client.dll”的文件。
6. 单击“确定”按钮，然后等待引用的添加。
7. 现在，您已经成功引用了金蝶云星空的API接口文件，可以在VBA代码中调用相关方法了。
8. 您可以使用VBA的对象和函数来实例化金蝶云星空的API接口，调用所需的服务和操作。
9. 例如，您可以创建一个新的对象来调用金蝶云星空的用户服务接口，并使用其中的方法来获取、创建或更新用户信息。
10. 在代码中，您还可以设置相关的参数、验证身份、处理返回的数据等等。
11. 当您完成代码编写后，您可以按下“F5”键或点击“运行”按钮来执行代码并调用金蝶云星空的API接口。
总之，通过在Excel VBA中引用金蝶云星空的API接口文件，您可以方便地调用并集成金蝶云星空的功能和数据，从而实现更高效的数据管理和处理。