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
Version imprimable
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
euh... rien compris à ta demande... :?
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:
Comme tu peux le voir tes deux textaera font partie de la class="free_t_t_texta"Citation:
<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>
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
professeur patricktoulon
Oui, aussi gentiment
J'espère que vous trouverez une solution
merci :ccool:
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.
J'espère trouver le problèmeCode:
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
Pour finir il n'y a pas de professeur, il n'y a que des bons élèves :mouarf:
Au plaisir
Bonjour
professeur patricktoulon
Merci pour la réponse
msgbox error
message
"Compile error: User-defined type not defined"
en
professeur patricktoulonCode:Sub WaitIE(IE As InternetExplorer)
Après avoir changé le code comme suit
n'a pas montré msgbox error
Le résultat traduction de message n'est pas montré?Code:
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
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
Fichier Excel a une macro en fichier attachéCode:
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
Bonjour
Oui si tu veux:
Sur ce site çà a l'air d'être plus rapide.Code:
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
J'ai supprimé ta substitution par le texte du code source, pas nécessaire dans ce cas là.
Ceci suffit
Au plaisirCode:Sheets("Sheet1").Range("L6").Value = Al_x.Document.all("result_box").innertext
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.
Au plaisirCode:
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
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
bonsoir
je n'ai pas acces a cette page je suis en france moi :mouarf::mouarf:
au plaisir
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
bonjour
au plaisirCode:
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
professeur patricktoulon
merci beaucoup
Code fonctionne efficacement 100%
Seul problème de retard
Merci encore professeur patricktoulon :ccool:
bonjour
si ca te convient je te suggere de cliquer sur résolu
au plaisir