Discussion :

[patricktoulon]

bonjour a tous
je vous propose aujourd'hui la translation d'une langue en une autre dans une cellule en utilisant google translation dynamiquement

un item au menu contextuel des cellules a été ajouté ("traduire cette valeur")
pour commencer on ajoute l'item au démarrage du classeur
attention
activez la reference microsoft html library et microsof internet control

Code :

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

1
2
3
4
5
6
7
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Resets'on reset le menu a la fermeture du classeur
End Sub
Private Sub Workbook_Open()
MenuCell' on appelle la fonction pour ajouter l'item au menu contextuel
End Sub

et les fonctions

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
 
Option Explicit
 
Sub MenuCell()
    Dim Mc As CommandBarControls, cpop, cbut, liste1 as string,i as variant
    Application.CommandBars("cell").Reset
    '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")
    Set Mc = CommandBars("Cell").Controls
    Set cpop = Mc.Add(msoControlPopup, 1, , 1, Temporary:=True)
    cpop.Caption = "traduire cette valeur"
    For i = 0 To UBound(liste1)
        Set cbut = cpop.Controls.Add(Type:=msoControlButton)
        With cbut
            .FaceId = 139
            .Caption = liste1(i)    '<-- label du bouton
            .OnAction = "traduction"
            .Tag = i
        End With
    Next
End Sub
 
Sub Resets()
    Application.CommandBars("cell").Reset
End Sub
 
Public Function traduction()
    Dim indexlgout As Long
   Dim IE As Object, cel
    indexlgout = CommandBars.ActionControl.Tag
     Set cel = ActiveCell
    Set IE = CreateObject("InternetExplorer.application")
    'on ouvre la page avec les donnnées
    IE.navigate "http://translate.google.com/#" & indexlgout & "/" & 0 & "/" & ActiveCell.Value    '0represente l'auto detection pour la langue de depart
    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 control et le resultat
    wait_ie IE    'attente du rafraichissement de la page avec la traduction
    ActiveCell = IE.Document.all("result_box").innertext    'on récupere 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

bonne utilisation

[Montor]

Et si les macros ont étés désactivées pour des raison de sécurité !

[patricktoulon]

bonjour montor

je pensais être dans les contributions Excel vba ce qui implique que vba est activé
enfin je pense

maintenant si tu a une solution sans macro je veux bien la connaitre

au plaisir

[mercatog]

A Patrick
Es tu sûr que liste1 est un String??

Une petite question, tu n'as pas spécifié la langue d'entrée

[patricktoulon]

Bonjour mercatog

ouppsss!!!! tu as raison je n'ai pas modifié le type.

Avant je l'utilisais en string avec un split par les "," je ne l'ai pas modifié par la suite.

Tu as raison je modifie tout de suite.
edit:

Ne pouvant pas le rééditer :

Code :

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

Dim Mc As CommandBarControls, cpop, cbut, liste1 as variant,i as variant

au plaisir

[patricktoulon]

Bonjour

pour la langue de depart c'etait deja mis en place par le 0 qui signifie "l'auto detection "

Code :

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

IE.navigate "http://translate.google.com/#" & indexlgout & "/" & 0 & "/" & ActiveCell.Value    '0 represente l'auto detection pour la langue de depart

metre "public liste1" en haut de module

et a la place de 0 metrre liste(X) x representant la langue de sortie dans liste1

[Ben_L]

Bonjour,

Code très intéressant !. Je ne connaissais pas les librairies que vous utilisez. Elles permettent de se passer de l'API Windows pour récupérer des informations sur internet (un gain de temps appréciable... ).

Ci-dessous quelques propositions d'amélioration dans le code du Module :
¤ Choix de la langue initiale et de la langue vers laquelle traduire.
¤ Protection contre une absence de connexion internet.
¤ Protection contre un changement de la cellule active durant le temps d'attente.
¤ Modification de la couleur de fond de la cellule active pour informer l'utilisateur que sa demande a bien été prise en compte.

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
 
Public Sub MenuCell()
    Dim mPop As CommandBarPopup, cPop As CommandBarPopup, cBtn As CommandBarButton
    Dim Lang() As Variant, LangAbrev() As Variant, i As Long, j As Long
    Application.CommandBars("cell").Reset
    Lang = Array("Allemand", "Anglais", "Espagnol", "Français", "Italien", "Portugais")    'liste des langues
    LangAbrev = Array("de", "en", "es", "fr", "it", "pt")    'liste des abréviations des langues pour l'adresse web
    Set mPop = CommandBars("Cell").Controls.Add(msoControlPopup, 1, , 1, Temporary:=True)
    mPop.Caption = "traduire cette valeur"
    Set cBtn = mPop.Controls.Add(Type:=msoControlButton)
    cBtn.Caption = "Depuis..."
    cBtn.Enabled = False
    For i = 0 To UBound(Lang)
        Set cPop = mPop.Controls.Add(Type:=msoControlPopup)
        With cPop
            .Caption = Lang(i)    '<-- label du bouton
            .Tag = LangAbrev(i)
        End With
        Set cBtn = cPop.Controls.Add(Type:=msoControlButton)
        With cBtn
            .Caption = "Vers..."
            .Enabled = False
        End With
        For j = 0 To UBound(Lang)
            Set cBtn = cPop.Controls.Add(Type:=msoControlButton)
            With cBtn
                .FaceId = 139
                .Caption = Lang(j)    '<-- label du bouton
                .OnAction = "traduction"
                .Tag = LangAbrev(j)
            End With
        Next j
    Next
End Sub
 
Public Sub Resets()
    Application.CommandBars("cell").Reset
End Sub
 
Public Sub traduction()
    Dim LangIn As String, LangOut As String, IE As Object, Adresse As String, Couleur As Long, Motif As Long
    Adresse = ActiveCell.Address
    Couleur = ActiveCell.Interior.Color
    Motif = ActiveCell.Interior.Pattern
    ActiveCell.Interior.Color = RGB(128, 128, 128)
    LangOut = CommandBars.ActionControl.Tag
    LangIn = CommandBars.ActionControl.Parent.Parent.Tag
    Set IE = CreateObject("InternetExplorer.application")
    IE.Visible = False    'rend invisible IE
    'on ouvre la page avec les donnnées
    IE.navigate "http://translate.google.com/?hl=fr&tab=wT#" & LangIn & "/" & LangOut & "/" & Hexa(Trim(ActiveCell.Value))
    Wait_IE IE    'attente du chargement complet de la page
    Application.Wait (Now + TimeValue("00:00:02"))    'attente de l'inscription des données dans le control et le resultat
    Wait_IE IE    'attente du rafraichissement de la page avec la traduction
    On Error Resume Next
    Range(Adresse).Value = IE.Document.all("result_box").innertext    'on récupere la traduction
    If Err.Number <> 0 Then MsgBox "Un problème est apparu lors de la traduction." & vbCrLf & "Vérifier votre connexion internet.", vbExclamation
    On Error GoTo 0
    IE.Quit    'on ferme l'object IE(l'instantiation d'internet explorer)
    Range(Adresse).Interior.Color = Couleur
    Range(Adresse).Interior.Pattern = Motif
End Sub
 
'sub d'attente du chargement complet de la page
Private Sub Wait_IE(IE)
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
End Sub
 
Private Function Hexa(Chaine As String) As String
    Dim i As Integer
    For i = 1 To Len(Chaine)
        Hexa = Hexa & "%" & Hex(Asc(Mid(Chaine, i, 1)))
    Next
End Function

Je n'ai pas eu le courage de relever les abréviations de chaque langue...
Je ne propose donc ici que les langues européennes les plus courantes.

Cdt

[patricktoulon]

bonjour ben-L

je te remerci pour le retour et tes suggestion

cela dit quand on parle d'amelioration de code on parle de :

reduction de code
fluidité de code
ce qui a pour conscequence une amelioration en terme de rapidité ,eficacité etc...
je n'est pas vu tout ton code mais ici deja au niveau de tes arrays
je ne vois pas l'interet de garder en memoire un 2 eme array (pour les abreviations )

puisque l'argument passe par le tag du bouton

je regarde de plus pret et je reviens

merci pour le retour

[Ben_L]

Concernant l'utilisation des Variant, je suis bien d'accord avec toi : mieux vaut s'en passer autant que possible.
J'aurais pu déclarer les 2 listes en tant que tableaux de String, mais alors impossible d'utiliser la fonction Array() qui a l'avantage de limiter le nombre de lignes de code nécessaires.

Ces Variant ne sont de plus gardés en mémoire qu'à l'ouverture du classeur, lors de l'exécution de la procédure MenuCell et sont détruits juste après, dès que celle-ci se termine. Ils n'occupent donc de la mémoire que durant un temps très court.

Quant à la raison d'être de la deuxième liste, celle des abréviations, c'est que chez moi, l'adresse web que tu utilises ne permet pas la traduction.
En effet, si je fais la requête web http://translate.google.com/#16/0/penser (qui correspondrait dans ton code, si j'ai bien compris, à la demande d'une traduction de "penser" en Anglais) la réponse de Google Trad est "penser".
J'ai donc fait quelques recherches Google Trad manuellement et ai noté les adresses web correspondantes. Celles-ci utilisaient des abréviations plutôt que des index pour spécifier les langues.
D'où mon choix d'ajouter une deuxième liste pour stocker ces abréviations tout en conservant la liste des noms de langue pour définir les Caption que voit l'utilisateur.

Je ne l'avais pas précisé dans mon message précédent mais j'ai également implémenté une conversion de la valeur de la cellule en hexadécimal pour permettre la traduction de chaines contenant plusieurs mots (donc contenant des espaces, que les adresses web n'apprécient guère...) et éviter des problèmes en cas de présence de caractères spéciaux (comme "/" qui ne fait pas non plus bon ménage avec les adresses).

Merci encore à toi pour cette idée de traduction via VBA.

[patricktoulon]

oupsss
j'ai encore parler trop vite

en fait je n'y avais pas pensé comme ca

tout réside la en fait

Code :

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

1
2
LangOut = CommandBars.ActionControl.Tag
    LangIn = CommandBars.ActionControl.Parent.Parent.Tag

il fallait y penser le menu en cascade

cela permet effectivement de pouvoir choir langue de départ dynamiquement autre que le français
vraiment tres bien
bon après les truc du genre colorisation de la cellules ca n'est pas obligatoire
mieux vaux l'adapter dans une autre macro
afin de garder la fonction le plus générique possible(pour tous)


encore une fois nickel
au plaisir

[patricktoulon]

re
voila j'ai pris quelques minute pour aller chercher les abreviation des langues

les voici:

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
'langue
   Lang = Array("Anglais", "Afrikaans", "Albanais", "Allemand", "Arabe", _
   "Arménien", "Azéri", "Basque", "Bengali", "Biélorusse", "Bosniaque", "Bulgare", "Catalan", "Cebuano", "chinois", _
   "Coréen", "Créole haïtien", "Croate", "Danois", "Espagnol", "Espéranto", "Estonien", "Finnois", "Français", "Galicien", _
   "Gallois", "Géorgien", "Grec", "Gujarati", "Hébreu", "Hindi", "Hmong", "Hongrois", "Indonésien", "Irlandais", _
   "Islandais", "Italien", "Japonais", "Javanais", "Kannada", "Khmer", "Laotien", "Latin", "Letton", "Lituanien", _
   "Macédonien", "Malaisien", "Maltais", "Marathi", "Néerlandais", "Norvégien", "Persan", "Polonais", "Portugais", _
   "Roumain", "Russe", "Serbe", "Slovaque", "Slovène", "Suédois", "Swahili", "Tagalog", "Tamoul", "Tchèque", "Telugu", _
   "Thaï", "Turc", "Ukrainien", "Urdu", "Vietnamien", "Yiddish")
 
 
  'abrégé
  LangAbrev = Array("en", "af", "sq", "de", "ar", "hy", "az", "eu", "bn", "be", "bs", "bg", _
    "ca", "ceb", "zh-CN", "ko", "ht", "hr", "da", "es", "eo", "et", "fi", "fr", "gl", "cy", "ka", "el", "gu", "iw", "hi", _
    "hmn", "hu", "id", "ga", "is", "it", "ja", "jw", "kn", "km", "lo", "la", "lv", "lt", "mk", "ms", "mt", "mr", "nl", "no", _
    "fa", "pl", "pt", "ro", "ru", "sr", "sk", "sl", "sv", "sw", "tl", "ta", "cs", "te", "th", "tr", "uk", "ur", "vi", "yi")

Au plaisir