使用 vba 翻译文本

Translate text using vba

提问by MariPlaza

Probably could be a rare petition, but here is the issue.

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

I am adapting an excel of a third-party to my organization. The excel is developed in English and the people of my organization just speaks Spanish. I want to use exactly the same code that the original worksheet have, I prefer don't touch it (although I can do it), so I want to use a function that every time that a msgbox appears (with the text in English), I translate the msgbox messages but without touching the original script. I am looking for a mask that could be called every time that a msgbox is invoked in the original code.

我正在将第三方的 excel 应用到我的组织中。excel 是用英语开发的，我组织的人只会说西班牙语。我想使用与原始工作表完全相同的代码，我更喜欢不要触摸它（尽管我可以做到），所以我想使用每次出现 msgbox 时的函数（带有英文文本） , 我翻译了 msgbox 消息，但没有触及原始脚本。我正在寻找一个可以在每次在原始代码中调用 msgbox 时调用的掩码。

I prefer don't touch the original code because the third-party developer could change it frequently, and it could be very annoying to change the code every time that they do any little change.

我更喜欢不要接触原始代码，因为第三方开发人员可能会经常更改它，并且每次他们做任何小的更改时都更改代码可能会非常烦人。

Is that possible?

那可能吗？

回答by Santosh

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

回答by Josh

This is how I would do it. It's function with optional enumeration objects that point to language codes used by google translate. For simplicity I only included a few language codes. Also, in this sample I selected the Microsoft Internet Controls reference so instead of creating an object, there's an InternetExplorer object used. And finally, to get rid of having to clean up the output, I just used .innerText rather than .innerHTML. Keep in mind, there's a character limit of around 3000 or so with google translate, and also, you must set IE=nothing especially if you will be using this multiple times, otherwise you will create multiple IE processes and eventually it won't work anymore.

这就是我要做的。它是带有可选枚举对象的函数，这些对象指向谷歌翻译使用的语言代码。为简单起见，我只包含了一些语言代码。此外，在此示例中，我选择了 Microsoft Internet Controls 参考，因此没有创建对象，而是使用了 InternetExplorer 对象。最后，为了摆脱清理输出的麻烦，我只使用了 .innerText 而不是 .innerHTML。请记住，谷歌翻译的字符限制约为 3000 左右，而且，您必须设置 IE=nothing，特别是如果您将多次使用它，否则您将创建多个 IE 进程，最终它将无法工作了。

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

回答by Vitalii Ivanov

One of the modern solution using Google Translation API To Enable Google Translation API, first you should create the project and credentials. If you receive 403 (Daily Limit), you need to add payment method into your Google Cloud Account, then you will get results instantly.

使用 Google Translation API 的现代解决方案之一要启用 Google Translation 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

回答by Unicco

Update:Improved For Each v In arr_Response-iteration, allowing special charactors. Added mouse-cursor change, when translation is processing. Added an example on how to improve the translated output_string.

更新：改进For Each v In arr_Response-iteration，允许特殊字符。在翻译处理时添加了鼠标光标更改。添加了有关如何改进翻译后的 output_string 的示例。

There are a majority of free translation API's outthere, but none really seems to beat Googles Translation Service, GTS (in my opinion). As a result of Googles' restrictions on the free GTS-usage, the best VBA-approach seems to be narrowed down to the IE.navigation - as Santosh's answer also emphasizes.

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

Using this approach, causes some problematics. The IE-instans doesn't know when the page is fully loaded, and IE.ReadyState is really not trusthworthy. Therefore the coder has to add "delays" using the Application.Waitfunction. When using this function, you are just guessing how long it would take, before the page is fully loaded. In situations where the internet is really slow, this hardcoded time, might not be enough. The following code fixes this, with the ImprovedReadyState.

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

In situations where a sheet has different columns, and you want to add different translation into every cell, I find the best approach where the translation-string is assigned to the ClipBoard, rather then calling a VBA-Function from within the formula. Thereby you can easily paste the translation, and modify it as a string.

在工作表具有不同列的情况下，您想在每个单元格中添加不同的翻译，我找到了将翻译字符串分配给剪贴板的最佳方法，而不是从公式中调用 VBA 函数。因此，您可以轻松粘贴翻译，并将其修改为字符串。

How to use:

如何使用：

1. Insert the procedures into a custom VBA-Module
2. Change the 4 Const's to your desire (see upper TranslationText)
3. Assign a shortkey to fire the TranslationText-procedure

1. 将程序插入自定义 VBA 模块
2. 将 4 个常量更改为您的愿望（见上TranslationText）
3. 分配一个快捷键来触发TranslationText-procedure

1. Activate the cell you want to translate. Required the first row to end with a language-tag. Etc. "_da", "_en", "_de". If you want another functionality, you change ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

4. 激活要翻译的单元格。要求第一行以语言标签结尾。等等“_da”、“_en”、“_de”。如果您想要其他功能，请更改ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

1. Press the shortkey from 4. (etc. CTRL + SHIRT + S). See proces in your processbar (bottom of excel). Paste (CTRL+V) when translation done is displayed:

5. 按 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

回答by Todd

The answer posted by Unicco is great!

Unicco 发布的答案很棒！

I removed the table stuff and made it work off a single cell, but the result is the same.

我删除了表格内容并使其在单个单元格中工作，但结果是相同的。

With some of the text I translate (operation instructions in a manufacturing context) Google occasionally adds crap to the return string, sometimes even doubling the response, using additional <"span"> constructs.

对于我翻译的一些文本（制造环境中的操作说明），谷歌偶尔会在返回字符串中添加废话，有时甚至使用额外的 <"span"> 结构将响应加倍。

I added the following line to the code right after 'Next v':

我在“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 realize I could have done this more efficiently, but, it works and I am moving on!

回想起来，我意识到我可以更有效地完成这项工作，但是，它有效，我正在继续前进！