Traduire du texte en utilisant vba
probablement une pétition rare, mais voici le problème.
je suis en train d'adapter un excel d'un tiers à mon organisation. Excel est développé en anglais et les gens de mon organisation parle espagnol. Je veux utiliser exactement le même code que la feuille de travail originale ont, je préfère ne pas le toucher (bien que je puisse le faire), donc je veux utiliser une fonction que chaque fois qu'une boîte MSG apparaît( avec le texte en anglais), je traduis les messages msgbox mais sans toucher le script original. Je cherche un masque qui pourrait être appelé chaque fois qu'une msgbox est invoquée dans le code original.
je préfère ne pas toucher au code original parce que le développeur tiers pourrait le changer fréquemment, et il pourrait être très ennuyeux de changer le code à chaque fois qu'ils font un petit changement.
Est-ce possible?
5 réponses
Ici vous allez.
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
C'est comme ça que je le ferais. C'est une fonction avec des objets d'énumération optionnels qui pointent vers les codes de langue utilisés par google translate. Pour simplifier, je n'ai inclus que quelques codes de langue. Aussi, dans cet exemple j'ai sélectionné la référence de Microsoft Internet Controls donc au lieu de créer un objet, il y a un objet InternetExplorer utilisé. Et enfin, pour se débarrasser d'avoir à nettoyer la sortie, j'ai juste utilisé .innerText plutôt que .innerHTML. Gardez à l'esprit, Il ya une limite de caractère de environ 3000 environ avec google translate, et aussi, vous devez définir IE=rien surtout si vous allez utiliser cela plusieurs fois, sinon vous allez créer plusieurs processus IE et finalement il ne fonctionnera plus.
le programme d'Installation...
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
de Test...
Sub Test()
Dim msg As String
msg = "Hello World!"
MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish)
End Sub
Fonction...
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
une solution moderne utilisant L'API de traduction de Google Pour activer L'API de traduction de Google, vous devez d'abord créer le projet et les justificatifs d'identité. Si vous recevez 403 (limite quotidienne), vous devez ajouter le mode de paiement dans votre compte Google Cloud, alors vous obtiendrez des résultats instantanément.
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
La réponse posté par Unicco est grand!
j'ai enlevé le truc de la table et je l'ai fait fonctionner sur une seule cellule, mais le résultat est le même.
avec une partie du texte que je traduis (instructions d'opération dans un contexte de fabrication) Google ajoute parfois de la merde à la chaîne de retour, parfois même en doublant la réponse, en utilisant des constructions supplémentaires <"span">.
j'ai ajouté la ligne suivante au code juste après 'Next v':
s_Translation = RemoveSpan(s_Translation & "")
Et créé cette fonction (à ajouter dans le même module):
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
rétrospectivement, je me rends compte que j'aurais pu faire plus efficacement, mais, il fonctionne, et je suis le mouvement!
mise à Jour: Amélioration de l' For Each v In arr_Response
-itération, permettant des caractères spéciaux. Ajouté le changement de curseur de souris, quand la traduction est en cours. Ajout d'un exemple sur la façon d'améliorer la traduction output_string.
il y a une majorité d'API de traduction libre, mais aucune ne semble vraiment battre Googles Translation Service, GTS (à mon avis). En raison des restrictions de Googles sur L'utilisation gratuite du GTS, la meilleure approche VBA semble se limiter à L'IE.navigation - comme le souligne la réponse de Santosh.
L'utilisation de cette approche pose quelques problèmes. L'IE-instans ne sait pas quand la page est complètement chargée, et IE.ReadyState est vraiment pas trusthworthy. Par conséquent, le codeur doit ajouter "delays" en utilisant le Application.Wait
fonction. En utilisant cette fonction, vous ne faites que deviner combien de temps cela prendrait, avant que la page soit entièrement chargée. Dans les situations où l'internet est vraiment lent, ce temps codé en dur, pourrait ne pas être suffisant. Les corrections de code suivantes ce, avec la ImprovedReadyState.
dans les situations où une feuille a des colonnes différentes, et vous voulez ajouter une traduction différente dans chaque cellule, je trouve la meilleure approche où la chaîne de traduction est assignée au bloc-notes, plutôt que d'appeler une fonction VBA de l'intérieur de la formule. Ainsi, vous pouvez facilement coller la traduction, et de la modifier comme une chaîne de caractères.
Comment utilisation:
- insérer les procédures dans un Module VBA personnalisé
- changez les 4 Const à votre désir (voir en haut
TranslationText
) - assignez un shortkey pour lancer le
TranslationText
procédure
- Activer la cellule que vous voulez traduire. Requis la première ligne pour terminer avec une balise de langue. Etc. "_da", "_en", "_de". Si vous voulez une autre fonctionnalité, vous changer
ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)
- appuyez sur la touche de raccourci à partir de 4. (etc. CTRL + CHEMISE + S). Voir proces dans votre barre de processus (bas d'excel). Collez (CTRL+V) lorsque la traduction est affiché:
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