Discussion :

[alidroos]

Bonjour

Je veux copier du texte d'une cellule à l'emplacement suivant et lorsque vous compilez résultat de la traduction pâte dans une cellule

http://www.worldlingo.com/en/product...ranslator.html

Merci pour tout

[Nicopilami]

euh... rien compris à ta demande...

[patricktoulon]

Bonjour

Si j'ai bien compris tu veux copier du texte d'une cellule en langue étrangère, l'insérer dans le textbox de la page du site translatons et la traduction doit revenir sur la cellule.
Regardes le tutoriel de qwazerty sur la manipulation de l'objet internet.

Edit:
J'ai regardé le code source de la page.
Voilà la partie qui nous intéresse:

<textarea id="wl_text" name="wl_text" wrap="soft" class="free_t_t_texta" tabindex="0" onchange="detectLanguage()" onblur="detectLanguage()" onmousedown="detectLanguage()" onmouseup="detectLanguage()" ></textarea>
</td>
<td>
<textarea id="wl_text_result" name="wl_text_result" style="background-color:transparent" wrap="soft" class="free_t_t_texta" readonly="readonly"></textarea>

Comme tu peux le voir tes deux textaera font partie de la class="free_t_t_texta"
Donc un get classname par ce nom, ensuite un bouclage sur les enfants de cette classe te donnera les textaeras.
Le reste n'est pas très difficile, comme on a les noms des deux textaera, une simple instantiation de l'objet IE et l'objet ("wl_text")=ta cellule
Il va falloir faire certainement un sleep pour attendre que la traduction soit faite, à moins que la fonction wait IE de qwazerty suffise en la relançant une 2 ème fois pendant la traduction.
Et ensuite ta cellule = l'object("wl_text_result")

Au plaisir

[alidroos]

professeur patricktoulon

Oui, aussi gentiment

J'espère que vous trouverez une solution

merci

[patricktoulon]

Bonjour

voilà je t'ai fait un exemple qui inscrit un texte en anglais à gauche et te le ressort en français à droite.

Pour le choix des langues le 1er item étant 0, l'anglais est = à 8
Pour la traduction en français se sera 10.

J'ai un problème à la fin pour récupérer la traduction mais je regarde.
Malgré le message d'erreur à la fin regarde le résultat sur la page du site.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
' ne pas oublier d'activer la reference microsoft html objetlibrary    !!!!!!
' ne pas oublier d'activer la reference microsoft internet control     !!!!!!
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""
Sub lancer_la_traduction()
'Déclaration des variables
    Dim IE As InternetExplorer
    Dim IEDoc As HTMLDocument
    Dim InputTranslatorZoneTexte As HTMLInputElement
    Dim outputTranslatorZoneTexte As HTMLInputElement
    Dim listelanguesource As HTMLSelectElement
    Dim listelangueresultat As HTMLSelectElement
    Dim boutonvalider As HTMLGenericElement
    'Initialisation des variables
    Set IE = CreateObject("InternetExplorer.Application")
    'Chargement d'une page web Google
    IE.Navigate "http://www.worldlingo.com/en/products_services/worldlingo_translator.html"
    WaitIE IE
    'Affichage de la fenêtre IE
    IE.Visible = True
    'On pointe le membre Document
    Set IEDoc = IE.document
    'On pointe notre Zone de texte a instruire
    Set InputTranslatorZoneTexte = IEDoc.all("wl_text")
    'on inscrit les données dans le textaera source
    InputTranslatorZoneTexte.Value = "hello the world"    'donc ici tu mettra la valeur de ta cellule
    'on selectione la langue source du texte inséré
    Set listelanguesource = IEDoc.all("wl_srclang")
    listelanguesource.selectedIndex = 8    'english'tu regarde dans la page les liste tu compte a partir de zero etc.. pour la langue que tu veux
    'on selectionne la langue de sortie
    Set listelangueresultat = IEDoc.all("wl_trglang")
    listelangueresultat.selectedIndex = 10    'francais
 
    'On pointe notre bouton valider
    Set boutonvalider = IEDoc.all("submit")
    'On simule un clic
    boutonvalider.Click
    'maintenant on attend la traduction
    WaitIE IE
    'On pointe notre Zone de texte du résultat
    Set outputTranslatorZoneTexte = IEDoc.all("wl_text_result")
    WaitIE IE
 
    Do
        DoEvents
    Loop Until outputTranslatorZoneTexte.Value <> ""    'ICI J'AI PERMISSION REFUSEE je ne sais pas encore pourquoi
    MsgBox outputTranslatorZoneTexte.Value
    Set IE = Nothing
    Set IEDoc = Nothing
End Sub
Sub WaitIE(IE As InternetExplorer)
'On boucle tant que la page n'est pas totalement chargée
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
End Sub

J'espère trouver le problème
Pour finir il n'y a pas de professeur, il n'y a que des bons élèves
Au plaisir

[alidroos]

Bonjour
professeur patricktoulon
Merci pour la réponse

msgbox error
message
"Compile error: User-defined type not defined"
en

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sub WaitIE(IE As InternetExplorer)

professeur patricktoulon

Après avoir changé le code comme suit
n'a pas montré msgbox error

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub lancer_la_traduction()
'Déclaration des variables
    Dim IE
    Dim IEDoc
    Dim InputTranslatorZoneTexte
    Dim outputTranslatorZoneTexte
    Dim listelanguesource
    Dim listelangueresultat
    Dim boutonvalider
    'Initialisation des variables
    Set IE = CreateObject("InternetExplorer.Application")
    'Chargement d'une page web Google
    IE.Navigate "http://www.worldlingo.com/en/products_services/worldlingo_translator.html"
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
'    WaitIE IE
    'Affichage de la fenêtre IE
    IE.Visible = True
    'On pointe le membre Document
    Set IEDoc = IE.document
    'On pointe notre Zone de texte a instruire
    Set InputTranslatorZoneTexte = IEDoc.all("wl_text")
    'on inscrit les données dans le textaera source
    InputTranslatorZoneTexte.Value = "hello the world"    'donc ici tu metra la valeur de ta cellule
    'on selectione la languesource du texte inseré
    Set listelanguesource = IEDoc.all("wl_srclang")
    listelanguesource.selectedIndex = 8    'english'tu regarde dans la page les liste tu compte a partir de zero etc.. pour la langue que tu veux
    'on selectionne la langue de sortie
    Set listelangueresultat = IEDoc.all("wl_trglang")
    listelangueresultat.selectedIndex = 10    'francais
    'On pointe notre bouton valider
    Set boutonvalider = IEDoc.all("submit")
    'On simule un clic
    boutonvalider.Click
    'maintenant on attend la traduction
'    WaitIE IE
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
 
    Set outputTranslatorZoneTexte = IEDoc.all("wl_text_result")
    Do Until IE.readyState = READYSTATE_COMPLETE
        DoEvents
    Loop
'    WaitIE IE
    Do
    DoEvents
    Loop Until outputTranslatorZoneTexte.Value <> ""    'ICI J'AI PERMISSION REFUSEE je ne sais pas encore pourquoi
    MsgBox outputTranslatorZoneTexte.Value
    Set IE = Nothing
    Set IEDoc = Nothing
End Sub

Le résultat traduction de message n'est pas montré?

macro gelée.

professeur patricktoulon

Cette macro fonctionne très bien
ĆáÇßä dans traduction Google
Si l'amendement possible du site : http://www.worldlingo.com/en/product...ranslator.html

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Public Sub Tr_Go()
Dim Al_x As Object, i As Long
Dim Ad_B As String, Ot_B As String, Tr_g As String, Da_re As String, C_d
Set Al_x = CreateObject("InternetExplorer.application")
    If Sheet1.ComboBox1.Value = "Detect" Then
        Ad_B = "auto"
    Else
        Ad_B = Application.WorksheetFunction.VLookup(Sheet1.ComboBox1.Value, Sheets("S_List").Range("a:b"), 2, 0)
    End If
    If Sheet1.ComboBox2.Value = "English" Then
        Ot_B = "en"
    Else
        Ot_B = Application.WorksheetFunction.VLookup(Sheet1.ComboBox2.Value, Sheets("S_List").Range("a:b"), 2, 0)
    End If
    Tr_g = Sheets("Sheet1").Range("b6").Value
    Al_x.Visible = False
    Al_x.navigate "http://translate.google.com/#" & Ad_B & "/" & Ot_B & "/" & Tr_g
    Do Until Al_x.ReadyState = 4
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:5"))
    Do Until Al_x.ReadyState = 4
        DoEvents
    Loop
    C_d = Split(Application.WorksheetFunction.Substitute(Al_x.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For i = LBound(C_d) To UBound(C_d)
        Da_re = Da_re & Right(C_d(i), Len(C_d(i)) - InStr(C_d(i), ">"))
    Next
    Sheets("Sheet1").Range("L6").Value = ""
    Sheets("Sheet1").Range("L6").Value = Da_re
    Al_x.Quit
    MsgBox "End Translation", vbOKOnly
End Sub

Fichier Excel a une macro en fichier attaché

[patricktoulon]

Bonjour

Oui si tu veux:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Public Sub Tr_Go()
    Dim Al_x As Object, i As Long
    Dim Ad_B As String, Ot_B As String, Tr_g As String, Da_re As String, C_d
    Set Al_x = CreateObject("InternetExplorer.application")
    Ad_B = IIf(Sheet1.ComboBox1.Value = "Detect", "auto", Application.WorksheetFunction.VLookup(Sheet1.ComboBox1.Value, Sheets("S_List").Range("a:b"), 2, 0))
    Ot_B = Application.WorksheetFunction.VLookup(Sheet1.ComboBox2.Value, Sheets("S_List").Range("a:b"), 2, 0)
    Tr_g = Sheets("Sheet1").Range("b6").Value
    Al_x.Visible = False
    Al_x.navigate "http://translate.google.com/#" & Ad_B & "/" & Ot_B & "/" & Tr_g
    wait_ie Al_x
    Application.Wait (Now + TimeValue("0:00:5"))
    wait_ie Al_x
    Sheets("Sheet1").Range("L6").Value = Al_x.Document.all("result_box").innertext
    Al_x.Quit
    MsgBox "Translation Terminée"
End Sub
Function wait_ie(IE)
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
End Function

Sur ce site çà a l'air d'être plus rapide.
J'ai supprimé ta substitution par le texte du code source, pas nécessaire dans ce cas là.
Ceci suffit

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Sheet1").Range("L6").Value = Al_x.Document.all("result_box").innertext

Au plaisir

Bonjour
Je te propose un autre exemple mais dans un userform.
Supprime ton sheets "list", on n'en a plus besoin.
Ajoute un userform dans ton classeur.
Dans cet userform place deux textbox multilignes côte à côte.
En dessous de ces textbox place 1 combobox respectivement bien en dessous de chaque textbox. Ensuite ajoute un bouton(commandbutton1).

Maintenant que tu as ton userform avec tes deux textbox, tes deux combobox et ton bouton, place ce code dans le module du userform.
Comme tu peux le constater, plus besoin du sheets list, ce qui rend cet userform parfaitement transportable et transférable puisque tout est dedans.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 
Option Explicit
Dim liste1, liste2
Private Sub CommandButton1_Click()
    TextBox2 = ""
    Dim lgdep As String, lgout As String
    lgdep = liste2(Me.ComboBox1.ListIndex)    'On prend l'index de la combobox pour prendre l'item correspondant à la liste des abréviations
    lgout = liste2(Me.ComboBox2.ListIndex)    'idem
    TextBox2 = traduction(lgdep, lgout, TextBox1)
    MsgBox "Translation Terminée"
End Sub
 
Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If CommandButton1.BackColor = &HC000& Then CommandButton1.BackColor = vbRed
End Sub
 
Private Sub UserForm_Activate()
'liste des langue
    liste1 = Array("Auto_Detection", "Afrikaans", "Albanian", "Arabic", "Armenian", "Azerbaijani", "Basque", "Belarusian" _
           , "Bengali", "Bulgarian", "Catalan", "Chinese", "Croatian", "Czech", "Danish", "Dutch", "English", "Esperanto", "Estonian" _
           , "Filipino", "Finnish", "French", "Galician", "Georgian", "German", "Greek", "Gujarati", "Haitian Creole", "Hebrew", "Hindi" _
           , "Hungarian", "Icelandic", "Indonesian", "Irish", "Italian", "Japanese", "Kannada", "Korean", "Latin", "Latvian", "Lithuanian" _
           , "Macedonian", "Malay", "Maltese", "Norwegian", "Persian", "Polish", "Portuguese", "Romanian", "Russian", "Serbian", "Slovak" _
           , "Slovenian", "Spanish", "Swahili", "Swedish", "Tamil", "Telugu", "Thai", "Turkish", "Ukrainian", "Urdu", "Vietnamese", "Welsh", _
                   "Yiddish")
    'liste des abbreviations
    liste2 = Array("auto", "af", "sq", "ar", "hy", "az", "eu", "be", "bn", "bg", "ca", "zh-CN", "hr", "cs", "da", "nl", "en", "eo", "et", "tl", "fi", _
                   "fr", "gl", "ka", "de", "el", "gu", "ht", "iw", "hi", "hu", "is", "id", "ga", "it", "ja", "kn", "ko", "la", "lv", "lt", "mk", "ms", "mt", "no", "fa", _
                   "pl", "pt", "ro", "ru", "sr", "sk", "sl", "es", "sw", "sv", "ta", "te", "th", "tr", "uk", "ur", "vi", "cy", "yi")
 
    ComboBox1.List = liste1: ComboBox2.List = liste1    ' Les deux combobox sont alimentées par la liste des langues
    ComboBox1.ListIndex = 0: ComboBox2.ListIndex = 21    'la combobox1 est à autodetect et la combo2 est à "french" dès le départ (à adapter )
End Sub
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If CommandButton1.BackColor = vbRed Then CommandButton1.BackColor = &HC000&
End Sub
'fonction de traduction
'Ne pas oublier d'activer la référence Microsoft html object  et Microsoft internet control.
Private Function traduction(lgshort As String, lgdep As String, texto As String) As String
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.application")
    'on ouvre la page avec les donnnées
    IE.navigate "http://translate.google.com/#" & lgshort & "/" & lgdep & "/" & texto
    IE.Visible = False    'Rend invisible IE
    wait_ie IE    'Attente du chargement complet de la page.
    Application.Wait (Now + TimeValue("0:00:2"))    'Attente de l'inscription des données dans le contrôle et le résultat.
    wait_ie IE    'Attente du rafraichissement de la page avec la traduction
    traduction = IE.Document.all("result_box").innertext    'on récupère la traduction.
    IE.Quit    'On ferme l'object IE(l'instantiation d'internet explorer)
End Function
'Fonction d'attente du chargement complet de la page
Function wait_ie(IE)
    IE.Visible = False
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
End Function

Au plaisir

[alidroos]

bonjour

Merci beaucoup professeur patricktoulon

S'il vous plaît modifier Code

Je veux une traduction de ce site:
http://www.worldlingo.com/en/product...ranslator.html

Merci encore professeur patricktoulon

[patricktoulon]

bonsoir
je n'ai pas acces a cette page je suis en france moi

au plaisir

[Henri-gp]

Il suffit de passer par le service Web de Google dédier à la traduction,
Il suffit de s’inscrire chez eux pour avoir une clef,

La traduction est super rapide et le code et n’en est que plus simple.

Henri

[patricktoulon]

bonjour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Sub teste()
    MsgBox traduction("hello the world")
End Sub
 
'fonction de traduction
'ne pas oublier d'activer la reference microsoft html object  et microsoft internet control
Public Function traduction(texto As String) As String
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.application")
    'on ouvre la page avec les donnnées
    IE.navigate "http://www.worldlingo.com/en/products_services/worldlingo_translator.html"
    IE.Visible = True    'rend invisible IE
    'attente du chargement complet de la page
    wait_ie IE
    'le cadre texte de depart
    IE.Document.all("wl_text").Value = texto
   'la liste de langue de depart
   IE.Document.all("wl_srclang").selectedIndex = 8
   'la liste de langue de traduction
    IE.Document.all("wl_trglang").selectedIndex = 10
     'on simule le click sur le bouton
     IE.Document.all("Submit").Click
    'un petit sleep de 7 seconde pour lui laisser le temps de rafraichir la page
    Application.Wait (Now + TimeValue("0:00:7"))
    'attente de l'inscription des données dans le control et le resultat
        wait_ie IE    'attente du du ready state complete avec la traduction
        traduction = IE.Document.all("wl_text_result").Value   'on récupere la traduction
    IE.Quit    'on ferme l'object IE(l'instantiation d'internet explorer)
End Function

au plaisir

[alidroos]

professeur patricktoulon

merci beaucoup

Code fonctionne efficacement 100%

Seul problème de retard

Merci encore professeur patricktoulon

[patricktoulon]

bonjour
si ca te convient je te suggere de cliquer sur résolu

au plaisir