Traduire du texte en utilisant vba

Question

pourrait probablement être une pétition rare, mais voici la question. 

J'adapte un Excel d'un tiers à mon organisation. Excel est développé en anglais et les membres de mon organisation ne parlent que l’espagnol. Je veux utiliser exactement le même code que la feuille de calcul d'origine, je préfère ne pas le toucher (même si je peux le faire), donc je veux utiliser une fonction qui chaque fois qu'une msgbox apparaît (avec le texte en anglais) , Je traduis les messages msgbox mais sans toucher au script original. Je cherche un masque qui pourrait être appelé chaque fois qu'une msgbox est invoquée dans le code d'origine. 

Je préfère ne pas toucher au code d'origine, car le développeur tiers pourrait le changer fréquemment et il pourrait être très ennuyant de changer le code à chaque fois qu'il fait un petit changement. 

Est-ce possible? 

Answer 1

Voici.

  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

Answer 2

Voici comment je le ferais. C'est une fonction avec des objets d'énumération facultatifs qui pointent vers les codes de langue utilisés par Google Translate. Pour simplifier, je n’ai inclus que quelques codes de langue. De plus, dans cet exemple, j'ai sélectionné la référence des contrôles Internet de Microsoft afin qu'au lieu de créer un objet, un objet InternetExplorer soit utilisé. Et enfin, pour me débarrasser de la tâche de nettoyage, je viens d'utiliser .innerText plutôt que .innerHTML. N'oubliez pas qu'il existe une limite de caractères d'environ 3000 ou plus avec Google Translate, et que vous devez définir IE = rien, surtout si vous l'utilisez plusieurs fois. Sinon, vous créerez plusieurs IE processus finalement cela ne fonctionnera plus.

Installer...

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

Tester...

Sub Test()

Dim msg As String

msg = "Hello World!"

MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish)

End Sub

Une 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

Answer 3

Une des solutions modernes utilisant l'API Google Traduction Pour activer l'API Google Traduction, vous devez tout d'abord créer le projet et les informations d'identification. Si vous recevez 403 (limite quotidienne), vous devez ajouter une méthode de paiement à votre compte Google Cloud, 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

Answer 4

Mise à jour: Improved For Each v In arr_Response- itération, autorisant des caractères spéciaux. Ajout du changement du curseur de la souris lors du traitement de la traduction. Ajout d'un exemple sur la façon d'améliorer la chaîne de sortie traduite.

Il existe une majorité d'API de traduction gratuite, mais aucune ne semble battre le service de traduction de Googles, GTS (à mon avis). En raison des restrictions imposées par Googles sur l'utilisation gratuite de GTS, la meilleure approche VBA semble être réduite à IE.navigation - comme le souligne également la réponse de Santosh. 

L’utilisation de cette approche pose quelques problèmes. IE-instans ne sait pas quand la page est complètement chargée, et IE.ReadyState n'est vraiment pas digne de confiance. Par conséquent, le codeur doit ajouter des "retards" à l'aide de la fonction Application.Wait. Lorsque vous utilisez cette fonction, vous vous demandez simplement combien de temps cela prendrait avant que la page ne soit entièrement chargée. Dans les situations où Internet est vraiment lent, ce temps codé en dur pourrait ne pas suffire. Le code suivant résout ce problème avec ImprovedReadyState. 

Dans les situations où une feuille comporte différentes colonnes et que vous souhaitez ajouter une traduction différente dans chaque cellule, je trouve la meilleure approche lorsque la chaîne de traduction est affectée au ClipBoard, plutôt que d'appeler une fonction VBA depuis la formule. Ainsi, vous pouvez facilement coller la traduction et la modifier sous forme de chaîne.

 

Comment utiliser:

1. Insérer les procédures dans un module VBA personnalisé
2. Changez les 4 constants à votre guise (voir TranslationText supérieur)
3. Attribuer une touche de raccourci pour déclencher la procédure TranslationText-

 

4. Activez la cellule que vous souhaitez traduire. Requis pour que la première ligne se termine par un tag de langue. Etc. "_da", "_en", "_de". Si vous voulez une autre fonctionnalité, vous changez ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

 

5. Appuyez sur la touche abrégée à partir de 4. (etc. CTRL + SHIRT + S). Voir proces dans votre barre de processus (bas d'Excel). Coller (CTRL + V) lorsque la traduction terminée est affichée:

   

    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

Answer 5

La réponse publiée par Unicco est géniale!

J'ai enlevé le contenu de la table et l'ai fait fonctionner avec 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 occasionnellement de la merde à la chaîne de retour, doublant même parfois la réponse, en utilisant des constructions <"span"> supplémentaires.

J'ai ajouté la ligne suivante au code juste après 'Next v':

s_Translation = RemoveSpan(s_Translation & "")

Et créé cette fonction (ajouter au 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 le faire plus efficacement, mais cela fonctionne et je passe à autre chose!