Update:For Each v In arr_Response Verbesserte -iteration, spezielle charactors ermöglicht. Mauszeigeränderung hinzugefügt, wenn die Übersetzung verarbeitet wird. Ein Beispiel hinzugefügt, wie der übersetzte output_string verbessert werden kann.
Es gibt einen Großteil der freien Übersetzung API outthere, aber keiner scheint Googles Translation Service, GTS zu schlagen (meiner Meinung nach). Als Folge der Beschränkungen von Googles auf die kostenlose GTS-Nutzung scheint der beste VBA-Ansatz auf die IE.navigation beschränkt zu sein - wie auch Santoshs Antwort betont.
Mit diesem Ansatz verursacht einige Probleme. Der IE-instans weiß nicht, wann die Seite vollständig geladen ist, und IE.ReadyState ist wirklich nicht vertrauenswürdig. Daher muss der Coder "Delays" mit der Funktion Application.Wait hinzufügen. Wenn Sie diese Funktion verwenden, erraten Sie nur, wie lange es dauert, bis die Seite vollständig geladen ist. In Situationen, in denen das Internet wirklich langsam ist, könnte diese fest codierte Zeit nicht ausreichen. Der folgende Code behebt das mit dem ImprovedReadyState.
In Situationen, in denen ein Blatt unterschiedliche Spalten hat und Sie in jede Zelle eine andere Übersetzung hinzufügen möchten, finde ich den besten Ansatz, wo die Übersetzungszeichenfolge dem ClipBoard zugewiesen wird, anstatt eine VBA-Funktion innerhalb der Formel. Dadurch können Sie die Übersetzung einfach einfügen und als String ändern.
Wie verwenden:
- Legen Sie die Verfahren in eine benutzerdefinierten VBA-Modul
- ändern Sie die 4 Const Ihren Wunsch der (siehe oberen
TranslationText)
- eines Vergeben Kurzschlussschlüssel zum Auslösen des
TranslationText -Verfahrens
- Aktivieren Sie die Zelle, die Sie übersetzen möchten. Die erste Zeile muss mit einem Language-Tag enden.Etc. "_da", "_en", "_de". Wenn Sie eine andere Funktionalität wollen, ändern Sie
ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
- Drücken Sie die Tastenkürzel von 4. (usw. CTRL + SHIRT + S). Siehe Prozess in Ihrer Prozessleiste (unten in Excel). Einfügen (STRG + V), wenn Übersetzung durchgeführt wird angezeigt:
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
ja, es ist möglich. –