Translate text with vba

probably may be a rare petition, but here's the problem.

I am adapting a third-party advantage to my organization. Excellence is developing in English, and the people in my organization just speak Spanish. I want to use exactly the same code as the source sheet, I prefer not to touch it (although I can do it), so I want to use a function that every time msgbox appears (with English text), I translated msgbox messages but not touching the original script. I am looking for a mask that can be called up every time msgbox is called in the source code.

I prefer not to touch the source code, because a third-party developer can change it often, and it can be very unpleasant to change the code every time they make any small changes.

Is it possible?

+8
source share
6 answers

Here you go.

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 
+15
source

This is how I do it. It works with optional enumeration objects that point to the language codes used in google translate. For simplicity, I have included only a few language codes. In addition, in this example, I selected the Microsoft Internet Controls link, so instead of creating an object, I used the InternetExplorer object. And finally, to get rid of the need to clear output, I just used .innerText, not .innerHTML. Keep in mind, there is a character limit of about 3000 or so using google translate, and you should set IE = nothing, especially if you use it several times, otherwise you will create several IE processes and, in the end, it will not work more.

Setup ...

 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 

Test ...

 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 
+5
source

One modern solution using the Google Translation APIs To enable the Google translation APIs, first create a project and credentials. If you get 403 (daily limit), you need to add a payment method to your Google Cloud account, after which you will receive the results instantly.

 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 
+1
source

Update: Improved For Each v In arr_Response -ituation, allowing the use of special characteristics. Added change of mouse cursor during translation processing. Added example of how to improve translated output_string.

There are most free translation APIs, but none of them really can beat the Googles Translation Service, GTS (in my opinion). As a result of Googles' restrictions on the free use of GTS, the best VBA approach seems to have narrowed down to IE.navigation - as Santos emphasizes.

Using this approach causes some problems. IE-instans does not know when the page is fully loaded, and IE.ReadyState is really not trustworthy. Therefore, the encoder must add “delays” using the Application.Wait function. When using this function, you simply guess how long it will take before the page is fully loaded. In situations where the Internet is really slow, this hard-coded time may not be enough. The following code fixes this with ImprovedReadyState.

In situations where the sheet has different columns and you want to add a different translation to each cell, I find a better approach when the translation line is assigned to ClipBoard rather than calling the VBA function from the formula, So you can easily insert the translation and change it as string.

Columns in Excel

How to use:

  • Insert procedures into custom VBA module
  • Change 4 Const as you wish (see top TranslationText )
  • Assign a short key to run TranslationText -procedure

Shortkey excel

  1. Activate the cell you want to translate. The first line is required to end with a language tag. Etc. "_da", "_en", "_de". If you need other functionality, you change ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

enter image description here

  1. Press the short key with 4. (etc. CTRL + SHIRT + S). See Proces in the processing panel (bottom Excel). Insert (CTRL + V) when translating:

enter image description here Translation completed

  Option Explicit 'Description: Translates content, and put the translation into ClipBoard 'Required References: MIS (Microsoft Internet Control) Sub TranslateText() 'Change Const 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 
0
source

The answer posted by Unicco is wonderful!

I deleted the table material and did the work from one cell, but the result is the same.

With some text that I translated (operating instructions in a production context), Google sometimes adds crap to the returned string, sometimes even doubling the answer using additional constructs .

I added the following line to the code immediately after "Next v":

 s_Translation = RemoveSpan(s_Translation & "") 

And created this function (add to the same module):

 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 

In retrospect, I understand that I could do it more efficiently, but it works, and I'm moving on!

0
source

I've been using this feature for over a year now, and it worked like a charm, but today it has stopped working.

String: result_data = IE.Document.getElementById("result_box").innerText

now an error is raised: an object is required (error 424)

If I copy the output of the transition to the browser, I get a google translation page where the text is translated.

Does Google override the html return page, so what is "result_box" called something else? And now what needs to be called?

0
source

Source: https://habr.com/ru/post/954954/


All Articles