Question

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

我正在为我的组织调整第三方的优秀成绩。 excel是用英语开发的，我组织的人员只讲西班牙语。我想使用与原始工作表完全相同的代码，我更喜欢不触摸它（虽然我可以这样做），所以我想使用每次出现msgbox时的函数（英文文本），我翻译msgbox消息，但没有触及原始脚本。我正在寻找一个可以在原始代码中每次调用msgbox时调用的掩码。

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

这可能吗？

Answer 1

你走了。

  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

Answer 2

我就是这样做的。它具有可选枚举对象的功能，指向谷歌翻译使用的语言代码。为简单起见，我只包含了一些语言代码。此外，在此示例中，我选择了Microsoft Internet Controls引用，因此不使用创建对象，而是使用了InternetExplorer对象。最后，为了摆脱不得不清理输出，我只使用.innerText而不是.innerHTML。请记住，谷歌翻译的字符限制大约在3000左右，而且，你必须设置IE =没有特别是如果你将多次使用这个，否则你将创建多个IE进程，最终它赢了＆＃39;不再工作了。

设置...

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

Answer 3

使用Google Translation API的现代解决方案之一要启用Google Translation API，首先应创建项目和凭据。如果您收到403（每日限额），则需要在Google云帐户中添加付款方式，然后您才能立即获得结果。

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

Answer 4

这是使用 Excel VBA 和 Google... 翻译文本的更简化方法。

此 VBA 用户定义函数应输入到标准代码模块中。

Function Translate$(sText$, FromLang$, ToLang$)
    Dim p1&, p2&, url$, resp$
    Const DIV_RESULT$ = "<div class=""result-container"">"
    Const URL_TEMPLATE$ = "https://translate.google.com/m?hl=[from]&sl=[from]&tl=[to]&ie=UTF-8&prev=_m&q="
    url = URL_TEMPLATE & WorksheetFunction.EncodeURL(sText)
    url = Replace(url, "[to]", ToLang)
    url = Replace(url, "[from]", FromLang)
    resp = WorksheetFunction.WebService(url)
    p1 = InStr(resp, DIV_RESULT)
    If p1 Then
        p1 = p1 + Len(DIV_RESULT)
        p2 = InStr(p1, resp, "</div>")
        Translate = Mid$(resp, p1, p2 - p1)
    End If
End Function

在单元格 A1 中包含以下文本：Every moment is a fresh beginning.

在单元格 B1 中输入以下公式：

=Translate(A1, "en", "fr")    '<--translates text in A1 from English to French.

单元格B1中的结果：Chaque instant est un nouveau départ.

当然这个 Translate() 函数也可以直接从 VBA 中使用：

MsgBox Translate([A1], "en", "de")  '<--displays: Jeder Moment ist ein Neuanfang.

当然您也可以手动使用翻译功能内置于 Excel 中，可在“审阅”选项卡上找到丝带。但是上面的 UDF 提供了一种快速而精简的方法以编程方式翻译文本。 Excel 的翻译能力不是通过 Excel 对象模型公开，所以像上面这样的函数可能很有用。

FromLang 和 ToLang 参数必须是下表中的代码：

 CODE   LANGUAGE
 en     English
 fr     French
 es     Spanish
 it     Italian
 de     German
 af     Afrikaans
 sq     Albanian
 am     Amharic
 ar     Arabic
 hy     Armenian
 az     Azerbaijani
 eu     Basque
 be     Belarusian
 bn     Bengali
 bs     Bosnian
 bg     Bulgarian
 ca     Catalan
 ceb    Cebuano
 ny     Chichewa
 zh-CN  Chinese (Simplified)
 zh-TW  Chinese (Traditional)
 co     Corsican
 hr     Croatian
 cs     Czech
 da     Danish
 nl     Dutch
 eo     Esperanto
 et     Estonian
 tl     Filipino
 fi     Finnish
 fy     Frisian
 gl     Galician
 ka     Georgian
 el     Greek
 gu     Gujarati
 ht     Haitian Creole
 ha     Hausa
 haw    Hawaiian
 iw     Hebrew
 hi     Hindi
 hmn    Hmong
 hu     Hungarian
 is     Icelandic
 ig     Igbo
 id     Indonesian
 ga     Irish
 ja     Japanese
 jw     Javanese
 kn     Kannada
 kk     Kazakh
 km     Khmer
 rw     Kinyarwanda
 ko     Korean
 ku     Kurdish (Kurmanji)
 ky     Kyrgyz
 lo     Lao
 la     Latin
 lv     Latvian
 lt     Lithuanian
 lb     Luxembourgish
 mk     Macedonian
 mg     Malagasy
 ms     Malay
 ml     Malayalam
 mt     Maltese
 mi     Maori
 mr     Marathi
 mn     Mongolian
 my     Myanmar (Burmese)
 ne     Nepali
 no     Norwegian
 or     Odia (Oriya)
 ps     Pashto
 fa     Persian
 pl     Polish
 pt     Portuguese
 pa     Punjabi
 ro     Romanian
 ru     Russian
 sm     Samoan
 gd     Scots Gaelic
 sr     Serbian
 st     Sesotho
 sn     Shona
 sd     Sindhi
 si     Sinhala
 sk     Slovak
 sl     Slovenian
 so     Somali
 su     Sundanese
 sw     Swahili
 sv     Swedish
 tg     Tajik
 ta     Tamil
 tt     Tatar
 te     Telugu
 th     Thai
 tr     Turkish
 tk     Turkmen
 uk     Ukrainian
 ur     Urdu
 ug     Uyghur
 uz     Uzbek
 vi     Vietnamese
 cy     Welsh
 xh     Xhosa
 yi     Yiddish
 yo     Yoruba
 zu     Zulu

Answer 5

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

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

使用这种方法会导致一些问题。 IE-instans不知道页面何时完全加载，IE.ReadyState实际上不值得信赖。因此，编码人员必须添加＆＃34;延迟＆＃34;使用Application.Wait函数。使用此功能时，您只是猜测在页面完全加载之前需要多长时间。在互联网非常慢的情况下，这个硬编码时间可能还不够。以下代码使用ImprovedReadyState修复此问题。

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

使用方法：

将过程插入自定义VBA模块
根据您的需要更改4个Const（请参阅上部TranslationText）
指定一个快捷键以触发TranslationText - 过程

激活要翻译的单元格。要求第一行以语言标记结束。等等＃34; _da＆＃34;，＆＃34; _en＆＃34;，＆＃34; _de＆＃34;。如果您想要其他功能，请更改ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

按下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

Answer 6

Unicco发布的答案很棒！

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

对于我翻译的一些文本（制造环境中的操作说明），Google偶尔会在返回字符串中添加垃圾，有时甚至会将响应加倍，使用额外的＆lt;＆＃34; span＆＃34;＆gt;构建体。

我在＆＃39; Next v＆＃39;：

之后的代码中添加了以下行

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

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

使用vba翻译文本

6 个答案: