XL 2016 VBA - Fonction traduction, accès refusé

[Remteyss]

Bonjour le forum,

Dans une macro, j'utilise la fonction traduction ci-dessous :

Public Function Translate(Optional texte As String, Optional From As String, Optional ToLang As String, Optional urlI As String)
    Dim RQ As Object, URL As String, code As String, elem As Object, x As Long
    Set RQ = CreateObject("microsoft.xmlhttp")    '"MSXML2.ServerXMLHTTP"
    If urlI <> "" Then
        URL = urlI
    Else
        URL = "https://translate.google.pl/m?&sl=" & From & "&tl=" & ToLang & "&ie=UTF-8&prev=_m&q=" & texte
    End If
    RQ.Open "POST", URL, False
    RQ.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
[B]    RQ.send[/B]
    With CreateObject("htmlfile")
        .body.innerhtml = RQ.responsetext
        Debug.Print Replace(RQ.responsetext, "<>", ">" & vbCrLf & "<")
        For Each elem In .ALL
            If elem.Tagname = "DIV" And elem.classname = "t0" Then Translate = elem.innerhtml: Exit For
        Next
    End With
End Function

Je l'ai testée hier et ça fonctionnait puis après l'avoir relancée une seconde fois, elle ne marchait plus. Ce matin, je rallume mon ordi et ça refonctionne puis la seconde, troisième, quatrième... fois elle ne marche plus. Voici le message d'erreur que je rencontre :

La ligne que j'ai mise en gras dans le code est celle surlignée par le débogueur.
N'ayant j'avais utilisé CreateObject je ne vois pas du tout quel est le problème, si vous avez des idées

Merci !

 

[patricktoulon]

re
tiens la version simplifiée avec en prime le convertisseur encode url

Option Explicit
'************************************************************
    'formule BASE                                               *
    '=Translate2(A1;"fr";"en";2)'conversion hexa                *
 '***********************************************************
Sub test()
MsgBox Translate2("bonjour tout le monde", "fr", "en", 2)
End Sub
Public Function Translate2(Optional SendText As String, Optional From As String = "en", Optional ToLang As String = "fr", Optional Convert = 0)
    Dim RQ As Object, URL$, elem As Object, X&
    Set RQ = CreateObject("microsoft.xmlhttp")    '"MSXML2.ServerXMLHTTP"
    If Convert <> 0 Then If Convert = 1 Then SendText = EncodeText1(SendText) Else SendText = EncodeText2(SendText)
    URL = "https://translate.google.pl/m?hl=" & From & "&sl=" & From & "&tl=" & ToLang & "&ie=UTF-8&prev=_m&q=" & SendText
    RQ.Open "POST", URL, False
    RQ.SetRequestheader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    RQ.send
    With CreateObject("htmlfile")
        .body.innerhtml = RQ.responsetext
        For Each elem In .ALL
            If elem.Tagname = "DIV" And elem.classname = "t0" Then Translate2 = elem.innerhtml: Exit For
        Next
    End With
    Debug.Print URL
End Function
Function EncodeText2(ByVal Texte As String) As String
    Dim P&, C$, A&
    For P = 1 To Len(Texte)
        C = Mid$(Texte, P, 1): A = AscW(C)
        Select Case A
        'Case 32: C = "+"'pour ceux qui préfèrent "+" au lieu de "%20"
        Case Is > 127: C = "\u" & Right$("000" & Hex$(A), 4)
        Case 0 To 44, 47, 58 To 64, 91 To 94, 96, 123 To 127: C = "%" & Right$("0" & Hex$(A), 2)
        End Select
        EncodeText2 = EncodeText2 & C
    Next P
End Function

 

[Remteyss]

Bonjour @patricktoulon
Merci pour ton retour, j'ai lancé ma macro et ça a bien marché jusqu'à l'une des dernières cases à traduire
Puis j'ai réessayé et là j'ai eu le message d'accès refusé directement...

P:S: A quoi correspond EncodeText1 ?

 

[patricktoulon]

re
encodetext2
ça ré encode les caractères spéciaux au format hexa de l'url
la 1 je te l'ai pas donné elle est moins au point
ainsi ceci
https://translate.google.pl/m?hl=fr&sl=fr&tl=en&ie=UTF-8&prev=_m&q=Les élèves vont à l'école.

devient cela
https://translate.google.pl/m?hl=fr&sl=fr&tl=en&ie=UTF-8&prev=_m&q=Les%20\u00E9l\u00E8ves%20vont%20\u00E0%20l%27\u00E9cole

on pourait voir le texte de cette case que tu veux traduire ?

 

[Remteyss]

re
encodetext2
ça ré encode les caractères spéciaux au format hexa de l'url
la 1 je te l'ai pas donné elle est moins au point
ainsi ceci
https://translate.google.pl/m?hl=fr&sl=fr&tl=en&ie=UTF-8&prev=_m&q=Les élèves vont à l'école.

devient cela
https://translate.google.pl/m?hl=fr&sl=fr&tl=en&ie=UTF-8&prev=_m&q=Les%20\u00E9l\u00E8ves%20vont%20\u00E0%20l%27\u00E9cole

on pourait voir le texte de cette case que tu veux traduire ?

Bonjour @patricktoulon
Oui mais dans la fonction Translate2 il y a cette ligne :

If Convert <> 0 Then If Convert = 1 Then SendText = EncodeText1(SendText) Else SendText = EncodeText2(SendText)

Il faut en fait lire EncodeText2 donc ?

C'est un fichier très volumineux que je ne peux malheureusement pas diffusé.

En fait, je ne pense pas que cela soit dû à une case en particulier. Ce matin le problème vient du fait que la fonction ne traduit plus, du moins elle considère la variable texte égale à "" puisque lorsque j'exécute ta procédure :

Sub test()
    MsgBox Translate2("bonjour tout le monde", "fr", "en", 2)
End Sub

j'obtiens :

Y aurait-il des lignes de code à ajouter au préalable avant d'utiliser la fonction CreateObject ?

 

[patricktoulon]

re
non a mon avis tu a des gros problèmes avec tes librairies
ma fonction fonctionne très bien sur une 20 aine de pc Windows différents

 

[Remteyss]

Oui je ne doute pas que ta fonction fonctionne
Je suis encore novice en VBA et n'avais pas activé les librairies "Microsoft HTML Object Librairy" et "Microsoft XML, v6.0". C'est chose faite mais le problème persiste

 

[patricktoulon]

tu n'avais pas besoins de l'activer c'est en late binding "createobject......"
tu peux activer ce que tu veux si elles sont fracca elles sont fracca
et là je peux rien pour toi désolé
soit une réparation d'office fera l'affaire soit c'est ton windows qui faut ré imager

 

[Remteyss]

Re,
D'accord je vois !
Je vais donc tester sur d'autres PC car j'ai lancé la macro et ça a fonctionné niquel !
Puis celle d'après la macro traduit encore ""

Merci pour ton aide en tout cas ainsi que pour ta fonction

Remteyss

 

[Remteyss]

Bonjour,

Je suis enfin parvenu à la traduction que j'attendais ! Mais bon qu'une seule fois, les autres fois ça m'arrivait même de demander une traduction vers l'allemand et j'obtenais du français...
J'attends donc l'intervention du service info et en attendant j'ai une petite question ; J'ai la version Excel 32 bits mais mon PC est en 64 bits. Je sais que dans ce sens ça ne devrait pas poser de soucis mais est-ce que vous pensez que cela pourrait éventuellement être une cause de mon problème ?

 

[patricktoulon]

re
bonsoir
non rien a voir moi aussi excel32 sur W7 64