使用vba翻译文本

可能可能是一个罕见的请愿，但这是问题。

我正在适应组织的第三方。 excel是用英语开发的，我的组织里的人讲西class牙语。 我想使用原来的工作表完全相同的代码，我宁愿不要触摸它（虽然我可以做到这一点），所以我想使用一个函数，每次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

这是我将如何做到这一点。 它是可选的枚举对象的function，指向谷歌翻译使用的语言代码。 为了简单，我只包含几个语言代码。 此外，在本示例中，我select了Microsoft Internet控件引用，因此不是创build对象，而是使用了InternetExplorer对象。 最后，为了摆脱必须清理输出，我只使用.innerText而不是.innerHTML。 请记住，谷歌翻译有大约3000左右的字符限制，而且，你必须设置IE =没有，特别是如果你将多次使用这个，否则你将创build多个IE进程，并最终将无法正常工作了。

build立… 

 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

testing… 

 Sub Test() Dim msg As String msg = "Hello World!" MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish) End Sub

function… 

 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

使用Google翻译API的现代解决scheme之一为了启用Google翻译API，首先您应该创build项目和凭证。 如果您收到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

Unicco发布的答案非常棒！

我删除了桌子的东西，并使其工作单个单元格，但结果是一样的。

对于我翻译的一些文本（制造环境中的操作说明），Google偶尔会将垃圾回收string添加到回送string中，有时甚至会使响应加倍，并使用额外的“span”结构。

我在“Next v”后面添加了以下代码行： 

 s_Translation = RemoveSpan(s_Translation & "")

并创build了这个function（添加到相同的模块）： 

 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

回想起来，我意识到我可以更有效地做到这一点，但是，它的工作，我正在前进！

更新：改进For Each v In arr_Response引用，允许特殊的字符。 当翻译正在处理时添加鼠标光标更改。 增加了一个关于如何改进翻译的output_string的例子。

有大部分免费翻译API的外面，但没有一个真的似乎击败谷歌翻译服务，GTS（在我看来）。 由于Googles对免费GTS使用的限制，最好的VBA方法似乎被缩小到IE.navigation – 正如Santosh的回答所强调的那样。

使用这种方法会导致一些问题。 IE-instans不知道什么时候页面被完全加载，IE.ReadyState真的不值得信任。 因此，编码器必须使用Application.Wait函数添加“延迟”。 使用这个函数时，你只是猜测在页面完全加载之前需要多长时间。 在互联网真的很慢的情况下，这个硬编码的时间可能是不够的。 以下代码使用ImprovedReadyState修复了这个问题。

在工作表具有不同列的情况下，如果要将不同的翻译添加到每个单元格中，我发现将翻译string分配给剪贴板的最佳方法，而不是从公式中调用VBA-Function。 因此，您可以轻松地粘贴翻译，并将其修改为string。

Excel中的列

如何使用：

  1. 将过程插入到自定义VBA模块中
  2. 改变你的愿望（请参阅上面的TranslationText ）
  3. 指定一个快捷键来激活TranslationText过程

Shortkey Excel

  1. 激活您要翻译的单元格。 要求第一行以语言标签结尾。 等“_da”，“_en”，“_de”。 如果你想要另一个function，你改变ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

在这里输入图像说明

  1. 按4.从短键（等CTRL + SHIRT + S）。 请参阅您的进程栏中的过程（excel的底部）。 显示完成翻译时粘贴（CTRL + V）：

在这里输入图像说明 翻译完成 

  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
    Interesting Posts

    使用DeepL API来翻译文本

    如何使用Google Translate API在Microsoft Excel中翻译文本？