Aktualizacja: Lepsza For Each v In arr_Response -iteration, pozwalając specjalne charactors. Dodano zmianę kursora myszy, gdy tłumaczenie jest przetwarzane. Dodano przykład, jak poprawić przetłumaczone output_string.
Istnieje większość bezpłatnych tłumaczeń API na zewnątrz, ale żadna z nich nie wydaje się być skuteczna w tłumaczeniu Googles, GTS (moim zdaniem). W wyniku restrykcji Googlesa w zakresie darmowego użycia GTS, najlepsze podejście VBA wydaje się być zawężone do IE.navigation - jak również podkreśla odpowiedź Santosha.
Stosowanie tego podejścia powoduje pewne problemy. IE-instans nie wie, kiedy strona jest w pełni załadowana, a IE.ReadyState naprawdę nie jest godna zaufania. Dlatego koder musi dodać "opóźnienia" za pomocą funkcji Application.Wait. Korzystając z tej funkcji, po prostu zgadujesz, ile czasu zajmie, zanim strona zostanie w pełni załadowana. W sytuacjach, gdy internet jest naprawdę wolny, ten zakodowany czas może nie wystarczyć. Poniższy kod naprawia to za pomocą funkcji ImprovedReadyState.
W sytuacjach, gdy arkusz ma różne kolumny i chcesz dodać inne tłumaczenie do każdej komórki, znajduję najlepsze podejście, w którym ciąg translacji jest przypisany do ClipBoard, zamiast wywoływania funkcji VBA z poziomu formuła. Dzięki temu możesz łatwo wkleić tłumaczenie i zmodyfikować je jako ciąg znaków.
Jak używać:
- Włóż procedur w niestandardowym VBA moduł
- zmienić 4 Konst do chęci (patrz górna
TranslationText)
- Przypisywanie skrót klawiszowy do wyzwalania
TranslationText -procedure
- aktywować komórki, które chcesz przetłumaczyć. Wymagany pierwszy wiersz do końca z tagiem języka.Itd. "_da", "_en", "_de". Jeśli chcesz inną funkcję, należy zmienić
ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
- Naciśnij shortkey od 4. (itd. CTRL + koszula + S). Zobacz proces na twoim pasku procesów (na dole programu Excel). Wklej (CTRL + V), gdy wyświetlane jest tłumaczenie zrobione:
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
tak, jest to możliwe. –