fonction google translate utilisable par formule ou VBA

Dranreb

XLDnaute Barbatruc
Bonsoir.
J'ai indiqué ici une fonction légèrement plus complète qui, sur les intervalles x = 1 à 31 et 33 à 127, suit mieux la fonction URLENCODAGE(CAR(x)) d'Excel 2013 et suivants.
En dehors des chiffres et des lettres non accentuées, seuls le point, le moins et le blanc souligné ne sont pas transformés. Même la virgule est changée en %2C.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonjour Dranreb
j'ai 2013 et 2007 mais j'utilise le plus souvent 2007 cette fonction ne m'est donc pas abordable
je préfère donc une fonction perso qui elle fonctionnera sur toutes versions excel ;)

quand a ton model "+complet" je n'arrive pas a l'adapter ca me sort n'importe quoi

VB:
Function EncodeText2(chaine) As String    'sur la base Dranreb exceldownload
    Dim chaine2$, P&, c$, cc$, A&
    chaine2 = chaine
    For P = 1 To Len(chaine)
        c = Mid$(chaine, P, 1): A = AscW(c)
       
         Select Case A
         Case 32: cc = "+" ' Worksheetfunction.EncodeURL renvoie "%20", mais bon, si "+" passe, c'est pas plus mal.
         Case Is > 127: cc = "\u" & Right$("000" & Hex$(A), 4) ' Worksheetfunction.EncodeURL renvoie une codification incompréhensible.
         Case 0 To 44, 47, 58 To 64, 91 To 94, 96, 123 To 127: cc = "%" & Right$("0" & Hex$(A), 2)
         End Select
     chaine2 = Replace(chaine2, c, cc)
     
       
       
        
    Next
    EncodeText2 = chaine2
End Function

résultat
\u00E9\u00E9\u00E8\u00E8 \u00E8 \u00E0 \u00E9'\u00E9\u00E9 \u00E9\u00E9

et donc le résultat de la requête n'en est pas moins bizarre

sans doute parce que le replace doit remplacer les lettre en hex précédemment remplacées
 

Dranreb

XLDnaute Barbatruc
Il faut évidemment l'appliquer à un texte brut, pas à un qui a déjà subi des transformations, c'est évident.
Et d'ailleurs ce n'est pas ma fonction. La mienne n'a pas de Replace: elle concatène au fûr et à mesure. Arrête de toujours tout refaire à ta sauce qui ne marche jamais :mad: Sinon je vais fini par ignorer tes interventions.
 

patricktoulon

XLDnaute Barbatruc
re
c'est pas une question de sauce c'est une question d'habitude tu a la tienne j'ai la mienne
avec la tienne je ne peux utiliser le replace en effet
Arrête de toujours tout refaire à ta sauce qui ne marche jamais
c'est toi qui le dit et je pourrais en dire autant mais je me le serais jamais permis ;)
au contraire je suis d'autant plus curieux quand les opinions sont opposé au mien
c'est la base pour échange dans un forum quel qu'en soit le thème
 

patricktoulon

XLDnaute Barbatruc
bonjour a tous
petite mise a jour
googletranslatemobile ayant intégré son web app translate idem a google translate
ma fonction est devenu inutilisable
en attendant mieux je vous propose la meme chose mais avec reverso
VB:
'italien:   ita
'anglais:   eng
'allemand:  ger
'espagnol:  spa
Sub test()
    MsgBox translate_In_Out("bonjour a tous sur ExcelDownloads", "fra", "spa")
End Sub

Function translate_In_Out(Texte, Optional LgIn$ = "fra", Optional LgOut$ = "eng")
    Dim req
    Set req = CreateObject("microsoft.xmlhttp")
    URL = "https://api.reverso.net/translate/v1/translation/"
    req.Open "get", URL, False
    req.SetRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
    req.SetRequestHeader "Content-Type", "application/json; charset=utf-8"
    req.SetRequestHeader "Referer", "https://www.reverso.net/translationresults.aspx?lang=FR&direction=francais-anglais"
    req.SetRequestHeader "Accept-Language", "fr-FR"
    req.SetRequestHeader "Origin", "https://www.reverso.net"
    req.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    req.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko/20100101 Firefox/22.0"
    req.SetRequestHeader "Host", "api.reverso.net"
    req.SetRequestHeader "DNT", 1
    req.SetRequestHeader "Connection", "Keep - Alive"
    req.SetRequestHeader "Cache-Control", "no-cache"
    req.send "{""input"":""" & Texte & """,""from"":""" & LgIn & """,""to"":""" & LgOut & """,""format"":""text"",""options"":{""origin"":""reversodesktop"",""sentenceSplitter"":true,""contextResults"":true,""languageDetection"":false}}"
      translate_In_Out = Split(Split(req.responsetext, "translation"":[""")(1), Chr(34))(0)
End Function
;)
 

soan

XLDnaute Barbatruc
Inactif
Bonjour @patricktoulon, @Dranreb, le fil,

j'ai essayé ton code VBA qui utilise le site reverso,
et j'confirme que ça fonctionne impeccable ! 😊

un grand bravo à toi ! 👍 👏 👏 👏




nota bene : tu as oublié de préciser que ça marche aussi
avec une fonction placée directement sur la feuille :


=translate_In_Out("bonjour a tous sur ExcelDownloads", "fra", "spa")

soan
 

patricktoulon

XLDnaute Barbatruc
Bonjour a tous
🍀a ben l'année 2022 commence bien 🍀
ayant réussi a choper la requête avec IE j'ai pu voir correctement l’entête de la demande et donc google translate revient en force youpi!!!;)
donc voila la nouvelle fonction provisoire "translate3"
VB:
Public Function Translate3(Optional SendText As String, Optional From As String = "en", Optional ToLang As String = "fr") As String
'*******************************************************************************
'fonction de traduction translate avec google translate
'auteur:patricktoulon sur exeldownloads
'version 3.0
'date: 03/01/2022
'******************************************************************************
  Dim Url$, Code$, elem
     Url = "https://translate.google.pl/m?sl=" & From & "&tl=" & ToLang & "&hl=fr&q=" & WorksheetFunction.EncodeURL(SendText)
       With CreateObject("microsoft.xmlhttp")
        .Open "get", Url, False
        .SetRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .SetRequestHeader "Referer", Url '"https://translate.google.pl/m?sl=fr&tl=en&hl=fr&q=" & WorksheetFunction.EncodeURL(SendText)
        .SetRequestHeader "Accept-Language", "fr-FR"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .SetRequestHeader "Accept-Encoding", "gzip, deflate"
        .SetRequestHeader "Host", "translate.google.pl"
        .SetRequestHeader "DNT", "1"
        .SetRequestHeader "Connection", "Keep - Alive"
        .send
        Code = .responsetext
        With CreateObject("htmlfile")
            .body.innerhtml = Code
            For Each elem In .body.all
                If elem.classname = "result-container" Then Translate3 = elem.innertext
            Next
        End With
    End With
End Function
Sub test()
    phrase$ = "meilleurs veux a tout les membres de XLD"
    MsgBox Translate3(phrase, "fr", "en")
    MsgBox Translate3(phrase, "fr", "es")
    MsgBox Translate3(phrase, "fr", "de")
    MsgBox Translate3(phrase, "fr", "it")
End Sub
 
Dernière édition:

chrisstreme

XLDnaute Nouveau
Bonjour PatrickToulon, Bonjour Le Forum !

Je suis ébahi par cette fonction qui cadre bien dans mon projet de traduction simultané. Je bloque cependant à l'intégration de formules dans mes onglets existants - serait il possible de se passer de formules et insérer cette fonction directement dans mon code?

par exemple:

VB:
For Each Cell In Worksheets("RA EN").Range("A7:Y" & 10)
        
        If Worksheets("RA EN").Cells <> "" Then
           Worksheets("RA FR").Cells = Translate(Worksheets("RA EN").Value, "en", "fr")
 Next Cell

me retourne une "erreur d'exécution 438"...
 

patricktoulon

XLDnaute Barbatruc
ah y regarder de plus je comprends mieux
si tu variablise un range sert toi de la variable comme tel ne l'affilie plus au parent
le code c'est ça
VB:
Sub test()
   Dim cell as Range
 For Each cell In Worksheets("RA EN").Range("A7:Y" & 10)
        If cell.Value <> "" Then cell.Value = Translate3(cell.Text, "en", "fr")
    Next
End Sub
Voilà Monsieur ;)
 

chrisstreme

XLDnaute Nouveau
Absolument génial...
Je lance le teste sur toute les lignes (et nn plus de 7 à 10 comme dans notre exemple)

=>ça fonctionne parfaitement sur le fichier d'origine : 188 lignes et 20 colonnes traduites de l'anglais en Français en 7 à 10 minutes.

Je m'attaque à étendre le projet à différentes langues

=> mathématiquement: 2 langues, 2 fois plus de temps...

Mais toujours plus efficient que la traduction cellule par cellule !
 
Dernière édition:

Gégé-45550

XLDnaute Accro
Bonjour et bravo à patricktoulon pour cette magnifique fonction, comme à l'accoutumée.
Ma curiosité ayant ainsi été aiguisée, je me suis permis d'en modifier la déclaration (à peine) comme ceci :
VB:
Public Function Translate3(Optional SendText As String, Optional ByVal From As String = "en", Optional ByVal ToLang As String = "fr") As String
afin de pouvoir lui passer des valeurs de cellules en paramètres.
De fil en aiguille, j'ai fini par créer un fichier avec toutes les langues actuellement disponibles dans Google Translate (version française) et les codes ISO-639 qui vont avec.
Ça a donné ceci (aperçu)
Traduction.png

et j'ai joint le fichier complet pour ceux qui seraient intéressés.
Encore bravo à Patrick Toulon.
 

Pièces jointes

  • Traduction.xlsm
    61 KB · Affichages: 21

Discussions similaires

Réponses
4
Affichages
130

Statistiques des forums

Discussions
311 725
Messages
2 081 942
Membres
101 849
dernier inscrit
florentMIG