可能可能是一个罕见的请愿，但这是问题。使用vba翻译文本
我正在适应我的组织的第三方的优秀。 excel是用英语开发的，我的组织中的人们只会说西班牙语。我想使用与原始工作表完全相同的代码，我更喜欢不要触摸它（尽管我可以做到这一点），所以我想使用一个函数，每当msgbox出现时（用英文文本） ，我翻译了msgbox消息，但未触及原始脚本。我正在寻找一个可以在每次调用msgbox的代码中调用的掩码。
我更喜欢不要触摸原始代码，因为第三方开发人员可能会频繁更改它，并且每次更改代码时都会非常恼人。
这可能吗？
你在这里。
Sub test()
Dim s As String
s = "hello world"
MsgBox transalte_using_vba(s)
End Sub
Function transalte_using_vba(str) As String
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA
Set IE = CreateObject("InternetExplorer.application")
' TO CHOOSE INPUT LANGUAGE
inputstring = "auto"
' TO CHOOSE OUTPUT LANGUAGE
outputstring = "es"
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:5"))
Do Until IE.ReadyState = 4
DoEvents
Loop
CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
IE.Quit
transalte_using_vba = result_data
End Function
更新：改进For Each v In arr_Response -iteration，允许特殊charactors。处理翻译时添加鼠标光标更改。增加了一个关于如何改进翻译后的output_string的例子。
有大部分免费翻译API的外面，但没有一个真的似乎击败谷歌翻译服务，GTS（在我看来）。由于Googles对免费GTS使用的限制，最好的VBA方法似乎被缩小到IE.navigation--正如Santosh的回答所强调的那样。
使用这种方法会导致一些问题。 IE-instans不知道页面什么时候完全加载，IE.ReadyState真的不值得信任。因此，编码器必须使用Application.Wait函数添加“延迟”。使用此功能时，您只需猜测在页面完全加载之前需要多长时间。在互联网真的很慢的情况下，这个硬编码时间可能还不够。以下代码使用ImprovedReadyState修复了这个问题。
在工作表具有不同列的情况下，如果您想在每个单元格中添加不同的翻译，我会找到将翻译字符串分配给ClipBoard的最佳方法，而不是从该范围内调用VBA-Function式。因此，您可以轻松粘贴翻译，并将其修改为字符串。
使用方法：
TranslationText）TranslationText - 程序
ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
Option Explicit
'Description: Translates content, and put the translation into ClipBoard
'Required References: MIS (Microsoft Internet Control)
Sub TranslateText()
'Change Const's to your desire
Const INPUT_RANGE As String = "table_products[productname_da]"
Const INPUT_LANG As String = "da"
Const PROCESSBAR_INIT_TEXT As String = "Processing translation. Please wait... "
Const PROCESSBAR_DONE_TEXT As String = "Translation done. "
Dim ws_ActiveWS As Worksheet
Dim r_ActiveCell As Range, r_InputRange As Range
Dim s_InputStr As String, s_InputLang As String, s_OutputLang As String, arr_Response() As String, s_Translation As String
Dim o_IE As Object, o_MSForms_DataObject As Object
Dim i As Long
Dim v As Variant
Set o_MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Set ws_ActiveWS = ThisWorkbook.ActiveSheet
Set r_ActiveCell = ActiveCell
Set o_IE = CreateObject("InternetExplorer.Application")
Set r_InputRange = ws_ActiveWS.Range(INPUT_RANGE)
'Update statusbar ("Processing translation"), and change cursor
Application.Statusbar = PROCESSBAR_INIT_TEXT
Application.Cursor = xlWait
'Declare inputstring (The string you want to translate from)
s_InputStr = ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
'Find the output-language
s_OutputLang = Right(ws_ActiveWS.Cells(1, r_ActiveCell.Column).Value, 2)
'Navigate to translate.google.com
With o_IE
.Visible = False 'Run IE in background
.Navigate "http://translate.google.com/#" & INPUT_LANG & "/" _
& s_OutputLang & "/" & s_InputStr
'Call improved IE.ReadyState
Do
ImprovedReadyState
Loop Until Not .Busy
'Split the responseText from Google
arr_Response = Split(.Document.getElementById("result_box").innerHTML, "<span class")
'Remove html from response, and construct full-translation-string
For Each v In arr_Response
s_Translation = s_Translation & Replace(v, "<span>", "")
s_Translation = Replace(s_Translation, "</span>", "")
s_Translation = Replace(s_Translation, """", "")
s_Translation = Replace(s_Translation, "=hps>", "")
s_Translation = Replace(s_Translation, "=atn>", "")
s_Translation = Replace(s_Translation, "=hps atn>", "")
'Improve translation.
'This could etc. be moved to seperate sheets (containing every language), and make the lookup in a dynamic table/sheet. Futurely it'd be possible to hook on the changeevent, and automatically improve the translation-algoritmen.
'If Google can't translate the etc. the word "Lys", you can extend the translation, with an auto correction. This example shows to autocorrect the word "Lys" -> "ljus".
If (s_OutputLang = "sv") Then
s_Translation = Replace(s_Translation, "lys", "ljus")
End if
Next v
'Put Translation into Clipboard
o_MSForms_DataObject.SetText s_Translation
o_MSForms_DataObject.PutInClipboard
If (s_Translation <> vbNullString) Then
'Put Translation into Clipboard
o_MSForms_DataObject.SetText s_Translation
o_MSForms_DataObject.PutInClipboard
'Update statusbar ("Translation done"). If the input_string is above 70 chars (which is roughly the limitation in processbar), then cut the string, and extend with "...".
Application.Statusbar = PROCESSBAR_DONE_TEXT & """" & IIf(Len(s_InputStr) < 70, s_InputStr, Mid(s_InputStr, 1, 70) & "...") & """"
Else
'Update statusbar ("Error")
Application.Statusbar = PROCESSBAR_ERROR_TEXT
End If
'Cleanup
.Quit
'Change cursor back to default
Application.Cursor = xlDefault
Set o_MSForms_DataObject = Nothing
Set ws_ActiveWS = Nothing
Set r_ActiveCell = Nothing
Set o_IE = Nothing
End With
End Sub
Sub ImprovedReadyState()
Dim si_PauseTime As Single: si_PauseTime = 1 'Set duration
Dim si_Start As Single: si_Start = Timer 'Set start-time
Dim si_Finish As Single 'Set end-time
Dim si_TotalTime As Single 'Calculate total time.
Do While Timer < (si_Start + si_PauseTime)
DoEvents
Loop
si_Finish = Timer
si_TotalTime = (si_Finish - si_Start)
End Sub
发表UNICCO答案是伟大的！
我删除了表格的东西，并使其工作单个单元格，但结果是相同的。
与一些我翻译（在制造方面的操作指令）谷歌偶尔也会增加废话返回的字符串，有时甚至翻倍的响应，使用附加<“跨度”>结构的文本。
添加以下行的代码之后“下一步V”：
s_Translation = RemoveSpan(s_Translation & "")
而且创造了这个功能（添加到相同的模块）：
Private Function RemoveSpan(Optional InputString As String = "") As String
Dim sVal As String
Dim iStart As Integer
Dim iEnd As Integer
Dim iC As Integer
Dim iL As Integer
If InputString = "" Then
RemoveSpan = ""
Exit Function
End If
sVal = InputString
' Look for a "<span"
iStart = InStr(1, sVal, "<span")
Do While iStart > 0 ' there is a "<span"
iL = Len(sVal)
For iC = iStart + 5 To iL
If Mid(sVal, iC, 1) = ">" Then Exit For ' look for the first ">" following the "<span"
Next
If iC < iL Then ' then we found a "<"
If iStart > 1 Then ' the "<span" was not in the beginning of the string
sVal = Left(sVal, iStart - 1) & Right(sVal, iL - iC) ' grab to the left of the "<span" and to the right of the ">"
Else ' the "<span" was at the beginning
sVal = Right(sVal, iL - iC) ' grap to the right of the ">"
End If
End If
iStart = InStr(1, sVal, "<span") ' look for another "<span"
Loop
RemoveSpan = sVal
End Function
现在回想起来，我意识到我本可以更有效地做到这一点，但是，它工作，我正在继续！
这就是我该怎么做的。它是可选的枚举对象的函数，指向谷歌翻译使用的语言代码。为了简单起见，我只包含几个语言代码。此外，在本示例中，我选择了Microsoft Internet控件参考，因此不是创建对象，而是使用了InternetExplorer对象。最后，为了摆脱必须清理输出，我只使用.innerText而不是.innerHTML。请记住，谷歌翻译的字符数限制在3000左右，而且，您必须设置IE =无，特别是如果您多次使用这个，否则您将创建多个IE进程并最终无法运行了。
设置...
Option Explicit
Const langCode = ("auto,en,fr,es")
Public Enum LanguageCode
InputAuto = 0
InputEnglish = 1
InputFrench = 2
InputSpanish = 3
End Enum
Public Enum LanguageCode2
ReturnEnglish = 1
ReturnFrench = 2
ReturnSpanish = 3
End Enum
测试...
Sub Test()
Dim msg As String
msg = "Hello World!"
MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish)
End Sub
功能...
Public Function AutoTranslate(ByVal Text As String, Optional LanguageFrom As LanguageCode, Optional LanguageTo As LanguageCode2) As String
Dim langFrom As String, langTo As String, IE As InternetExplorer, URL As String, myArray
If IsMissing(LanguageFrom) Then
LanguageFrom = InputAuto
End If
If IsMissing(LanguageTo) Then
LanguageTo = ReturnEnglish
End If
myArray = Split(langCode, ",")
langFrom = myArray(LanguageFrom)
langTo = myArray(LanguageTo)
URL = "https://translate.google.com/#" & langFrom & "/" & langTo & "/" & Text
Set IE = New InternetExplorer
IE.Visible = False
IE.Navigate URL
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:5"))
Do Until IE.ReadyState = 4
DoEvents
Loop
AutoTranslate = IE.Document.getElementByID("result_box").innerText
IE.Quit
Set IE = Nothing
End Function
一个使用谷歌翻译API 启用谷歌的现代解决方案翻译API，首先你应该创建项目和凭证。如果您收到403（每日限额），则需要将付款方式添加到您的Google Cloud帐户中，然后您会立即收到结果。
Private Function GoogleTranslateJ(ByVal text, ByVal resLang, ByVal srcLang) As String
Dim jsonProvider As Object
Dim jsonResult As Object
Dim jsonResultText As String
Dim googleApiUrl As String
Dim googleApiKey As String
Dim resultText As String
Set jsonProvider = CreateObject("MSXML2.ServerXMLHTTP")
text = Replace(text, " ", "%20")
googleApiKey = "ijHF28h283fjijefiwjeofij90f2h923" 'YOUR GOOGLE API KEY
googleApiUrl = "https://translation.googleapis.com/language/translate/v2?key=" & googleApiKey & "&source=" & srcLang & "&target=" & resLang & "&q=" & text
jsonProvider.Open "POST", googleApiUrl, False
jsonProvider.setRequestHeader "Content-type", "application/text"
jsonProvider.send ("")
jsonResultText = jsonProvider.responseText
Set jsonResult = JsonConverter.ParseJson(jsonResultText)
Set jsonResult = jsonResult("data")
Set jsonResult = jsonResult("translations")
Set jsonResult = jsonResult(1)
resultText = jsonResult("translatedText")
GoogleTranslateJ = resultText
End Function
是的，这是可能的。 – 2013-09-30 15:41:39