可能是一个罕见的请愿书，但这是问题所在。
我正在为我的组织调整第三方的 excel。excel是用英语开发的，我组织的人只会说西班牙语。我想使用与原始工作表完全相同的代码，我更喜欢不要触摸它（尽管我可以做到），所以我想使用一个函数，每次出现 msgbox 时（带有英文文本） ，我翻译了 msgbox 消息，但没有触及原始脚本。我正在寻找一个可以在每次在原始代码中调用 msgbox 时调用的掩码。
我宁愿不要碰原始代码，因为第三方开发人员可能会经常更改它，而且每次他们做任何微小的更改时都更改代码可能会非常烦人。
那可能吗？
干得好。
Sub test()
Dim s As String
s = "hello world"
MsgBox translate_using_vba(s)
End Sub
Function translate_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
我就是这样做的。它具有可选枚举对象的功能，这些对象指向谷歌翻译使用的语言代码。为简单起见，我只包含了一些语言代码。此外，在此示例中，我选择了 Microsoft Internet Controls 引用，因此没有创建对象，而是使用了 InternetExplorer 对象。最后，为了避免清理输出，我只使用了 .innerText 而不是 .innerHTML。请记住，谷歌翻译的字符限制约为 3000 左右，而且，您必须设置 IE=nothing，特别是如果您将多次使用它，否则您将创建多个 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
这是使用 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
使用 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
更新：改进For Each v In arr_Response的迭代，允许特殊字符。在处理翻译时添加了鼠标光标更改。添加了一个关于如何改进翻译后的 output_string 的示例。
那里有大多数免费翻译 API，但似乎没有一个能真正击败 Google 的翻译服务 GTS（在我看来）。由于谷歌对免费 GTS 使用的限制，最好的 VBA 方法似乎缩小到 IE.navigation - 正如 Santosh 的回答也强调的那样。
使用这种方法会导致一些问题。IE-instans 不知道页面何时完全加载，并且 IE.ReadyState 确实不可信。因此编码器必须使用该Application.Wait函数添加“延迟”。使用此功能时，您只是在猜测页面完全加载之前需要多长时间。在互联网真的很慢的情况下，这个硬编码的时间可能还不够。以下代码使用改进的ReadyState 解决了这个问题。
在工作表具有不同列的情况下，并且您希望将不同的翻译添加到每个单元格中，我发现将翻译字符串分配给剪贴板的最佳方法，而不是从公式中调用 VBA 函数。因此，您可以轻松粘贴翻译，并将其修改为字符串。
如何使用：
TranslationText）TranslationText-procedure
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发布的答案很棒！
我删除了表格的东西，让它在一个单元格上工作，但结果是一样的。
对于我翻译的一些文本（制造环境中的操作说明），Google 偶尔会在返回字符串中添加废话，有时甚至会使用额外的 <"span"> 构造使响应加倍。
我在“Next 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
回想起来，我意识到我本可以更有效地做到这一点，但是，它奏效了，我正在继续前进！