Public Function Translate(Optional texte As String, Optional From As String = "en", Optional ToLang As String = "fr", 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?hl=" & From & "&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)"
RQ.send
With CreateObject("htmlfile")
.body.innerhtml = RQ.responsetext
For Each elem In .ALL
If elem.Tagname = "DIV" And elem.classname = "t0" Then Translate = elem.innerhtml: Exit For
Next
End With
End Function
Merci ça fonctionne impeccable, mais il faut quand même installer la fonction "TRANSLATE" (.msi) si non cela fonctionne pas.
si non cela fonctionne pas
Function TxtCodé(ByVal TxtClair As String) As String
Const LetAcc = "àâéèêëiîôùûü"
Dim P As Long, C As String * 1
TxtCodé = TxtClair
For P = 1 To Len(LetAcc)
C = Mid$(LetAcc, P, 1): TxtCodé = Replace$(TxtCodé, C, "\u" & Right$("0000" & LCase$(Hex$(AscW(C))), 4))
C = UCase$(C): TxtCodé = Replace$(TxtCodé, C, "\u" & Right$("0000" & LCase$(Hex$(AscW(C))), 4))
Next P
End Function
Function TxtClair(ByVal TxtCodé As String) As String
Dim TSpl() As String, P As Long
TSpl = Split(TxtCodé, "\u")
For P = 1 To UBound(TSpl): TSpl(P) = ChrW$(Val("&H" & Left$(TSpl(P), 4))) & Mid$(TSpl(P), 5): Next P
TxtClair = Join(TSpl, "")
End Function
Function TxtCodé(ByVal TxtClair As String) As String
Dim TJn() As String, P As Long, C As String * 1, A As Integer, J As Long
ReDim TJn(0 To 0)
For P = 1 To Len(TxtClair)
C = Mid$(TxtClair, P, 1): A = AscW(C)
If A > 127 Then
J = J + 1: ReDim Preserve TJn(0 To J)
TJn(J) = Right$("000" & LCase$(Hex$(A)), 4)
Else
TJn(J) = TJn(J) & C
End If: Next P
TxtCodé = Join$(TJn, "\u")
End Function
Function TxtClair(ByVal TxtCodé As String) As String
Dim TJn() As String, J As Long
TJn = Split(TxtCodé, "\u")
For J = 1 To UBound(TJn): TJn(J) = ChrW$(Val("&H" & Left$(TJn(J), 4))) & Mid$(TJn(J), 5): Next J
TxtClair = Join$(TJn, "")
End Function
A Un texte bien de chez nous (Constante texte) | B Language XML =TxtCodé(A1) | C Retraduit en clair =TxtClair(B1) | |
---|---|---|---|
1 | Île-de-France | \u00cele-de-France | Île-de-France |
2 | Joyeux Noël | Joyeux No\u00ebl | Joyeux Noël |
3 | La charrue avant les bœufs | La charrue avant les b\u0153ufs | La charrue avant les bœufs |
4 | ç'en est trop | \u00e7'en est trop | ç'en est trop |
5 | Lætitia | L\u00e6titia | Lætitia |
Cette fonction ne change rien a moins que je l'ai mal collé.Fonction TxtCodé rectifiée pour ne pas risquer de louper certains caractères :VB:Function TxtCodé(ByVal TxtClair As String) As String Dim TJn() As String, P As Long, C As String * 1, A As Integer, J As Long ReDim TJn(0 To 0) For P = 1 To Len(TxtClair) C = Mid$(TxtClair, P, 1): A = AscW(C) If A > 127 Then J = J + 1: ReDim Preserve TJn(0 To J) TJn(J) = Right$("000" & LCase$(Hex$(A)), 4) Else TJn(J) = TJn(J) & C End If: Next P TxtCodé = Join$(TJn, "\u") End Function Function TxtClair(ByVal TxtCodé As String) As String Dim TJn() As String, J As Long TJn = Split(TxtCodé, "\u") For J = 1 To UBound(TJn): TJn(J) = ChrW$(Val("&H" & Left$(TJn(J), 4))) & Mid$(TJn(J), 5): Next J TxtClair = Join$(TJn, "") End Function
A
Un texte bien de chez nous
(Constante texte)B
Language XML
=TxtCodé(A1)C
Retraduit en clair
=TxtClair(B1) 1Île-de-France \u00cele-de-France Île-de-France 2Joyeux Noël Joyeux No\u00ebl Joyeux Noël 3La charrue avant les bœufs La charrue avant les b\u0153ufs La charrue avant les bœufs 4ç'en est trop \u00e7'en est trop ç'en est trop 5Lætitia L\u00e6titia Lætitia
Public Function Translate(Optional texte As String, Optional From As String = "en", Optional ToLang As String = "fr", Optional urlI As String)
Dim RQ As Object, URL As String, code As String, elem As Object, X As Long
t1 = "âÄàéèéèêëiîôùûü": t2 = "aAaeeeeeeiIoouuu"
For i = 1 To Len(t1): texte = Replace(texte, Mid(t1, i, 1), Mid(t2, i, 1)): Next
Set RQ = CreateObject("microsoft.xmlhttp") '"MSXML2.ServerXMLHTTP"
If urlI <> "" Then
URL = urlI
Else
URL = "https://translate.google.pl/m?hl=" & From & "&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)"
RQ.send
With CreateObject("htmlfile")
.body.innerhtml = RQ.responsetext
For Each elem In .ALL
If elem.Tagname = "DIV" And elem.classname = "t0" Then Translate = elem.innerhtml: Exit For
Next
End With
End Function
Mais… vous ne les avez pas du tout utilisées dans votre Function Translate, pour transformer vos textes dans un sens puis dans l'autre !Cette fonction ne change rien a moins que je l'ai mal collé.
Sub Test()
Dim Z As String
Z = Translate("rien à voir", "fr", "en") _
& vbLf & Translate(UHexaTexte("rien à voir"), "fr", "en") _
& vbLf & Translate("nothing to see", "en", "fr")
With New MSForms.DataObject: .SetText Z: .PutInClipboard: End With
MsgBox Z, vbInformation, "Test"
End Sub
Function UHexaTexte(ByVal texte As String) As String
Rem. —— Renvoie un texte dont chaque caractères de code ASCII > 127 est remplacé
' par "\u" suivi du code hexadécimal de 4 de long de ce code ASCII.
Dim TJn() As String, P As Long, C As String * 1, A As Integer, J As Long
ReDim TJn(0 To 0)
For P = 1 To Len(texte)
C = Mid$(texte, P, 1): A = AscW(C)
If A > 127 Then
J = J + 1: ReDim Preserve TJn(0 To J)
TJn(J) = Right$("000" & Hex$(A), 4)
Else
TJn(J) = TJn(J) & C
End If: Next P
UHexaTexte = Join$(TJn, "\u")
End Function
Function TexteUHexa(ByVal UHexa As String) As String
Rem. —— Renvoie un texte dont chaque groupe "\u" suivi d'un code ascii hexadécimal
' de 4 de long est remplacé par le caractère correspondant.
Dim TJn() As String, J As Long
TJn = Split(UHexa, "\u")
For J = 1 To UBound(TJn): TJn(J) = ChrW$(Val("&H" & Left$(TJn(J), 4))) & Mid$(TJn(J), 5): Next J
TexteUHexa = Join$(TJn, "")
End Function
nothing ? see
nothing to see
rien à voir
Sub Test2()
Dim Z As String
Z = Translate("Les élèves vont à l'école.", "fr", "en") _
& vbLf & Translate(UHexaTexte("Les élèves vont à l'école."), "fr", "en")
With New MSForms.DataObject: .SetText Z: .PutInClipboard: End With
MsgBox Z, vbInformation, "Test"
End Sub
Curieux qu'il comprenne quand même le mot "élèves" non traité. Peut être déduit-il d'une recherche en trouvant qu'il n'y a que ce mot qui soit de la forme ?l?ves …The students go? the? cole.
The students are going to the school.