अद्यतन: बेहतर For Each v In arr_Response -iteration, विशेष charactors की इजाजत दी। अनुवाद संसाधित होने पर माउस-कर्सर परिवर्तन जोड़ा गया। अनुवादित output_string को बेहतर बनाने के तरीके पर एक उदाहरण जोड़ा गया।
मुफ्त अनुवाद एपीआई के बाहर बहुत सारे हैं, लेकिन वास्तव में कोई भी गुगल अनुवाद सेवा, जीटीएस (मेरी राय में) को हरा नहीं देता है। मुक्त जीटीएस-उपयोग पर गूगल्स के प्रतिबंधों के परिणामस्वरूप, सर्वोत्तम वीबीए-दृष्टिकोण को आईई.विगेशन में संकुचित किया गया है - क्योंकि संतोष के उत्तर पर जोर दिया जाता है।
इस दृष्टिकोण का उपयोग करके, कुछ समस्याएं उत्पन्न होती हैं। आईई-इंस्टेंस नहीं जानते कि पृष्ठ पूरी तरह से लोड होने पर, और IE.ReadyState वास्तव में भरोसेमंद नहीं है। इसलिए कोडर को Application.Wait फ़ंक्शन का उपयोग करके "देरी" जोड़नी पड़ती है। इस फ़ंक्शन का उपयोग करते समय, आप अनुमान लगा रहे हैं कि पृष्ठ पूरी तरह से लोड होने से पहले कितना समय लगेगा। ऐसी परिस्थितियों में जहां इंटरनेट वास्तव में धीमा है, यह कठोर समय, पर्याप्त नहीं हो सकता है। निम्न कोड सुधारित रीडस्टेट के साथ इसे ठीक करता है।
ऐसी परिस्थितियों में जहां शीट के अलग-अलग कॉलम होते हैं, और आप प्रत्येक सेल में अलग-अलग अनुवाद जोड़ना चाहते हैं, मुझे सबसे अच्छा तरीका मिल जाता है जहां अनुवाद-स्ट्रिंग को क्लिपबोर्ड पर असाइन किया जाता है, बल्कि फिर से वीबीए-फ़ंक्शन को कॉल करना सूत्र। इस प्रकार आप आसानी से अनुवाद पेस्ट कर सकते हैं, और इसे एक स्ट्रिंग के रूप में संशोधित कर सकते हैं।
उपयोग कैसे करें:
- एक कस्टम VBA-मॉड्यूल
- बदलें में प्रक्रियाओं डालें 4 कॉन्स्ट की अपनी इच्छा को (देखें ऊपरी
TranslationText)
- एक निरुपित
TranslationText -प्रोसेचर
आग करने के लिए शॉर्टकी
- सेल आप अनुवाद करना चाहते को सक्रिय करें। भाषा-टैग के साथ समाप्त होने वाली पहली पंक्ति की आवश्यकता होती है।आदि "_da", "_en", "_de"। यदि आप किसी अन्य कार्यक्षमता चाहते हैं, आप बदल
ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
- प्रेस 4. से shortkey (आदि Ctrl + शर्ट + S)। अपनी प्रोसेसबार (एक्सेल के नीचे) में प्रोसेस देखें। पेस्ट करें (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
हाँ, यह संभव है। –