Traduction Francais - Anglais
Bonsoir à tous,
J'aimerais réaliser une macro qui, à l'aide de deux boutons (Bouton1 = Francais, Bouton2 = English), va chercher les noms de champs (Feuil1) et les mettre à jour dans la Feuil2 selon la langue choisie.
Merci à l'avance de votre aide !
Fleaa
Personne pour m'aider ?
Fleaa
Bonjour, pas étonnant que personne ne se soit manifesté. Fournissez-nous une explication digne d'un "qui fait quoi ou quand comment" parce que la méthode actuelle n'a pas l'air d'avoir porté ses fruits.
Bonjour Excelator,
Dans la Feuil3 si tu cliques sur le bouton "Francais", la macro va chercher dans la Feuil1 les champs en francais qui se trouvent dans la colonne C et les mettre à jour dans la Feuil2 dans le bon ordre. Pareil pour le bouton "English" quand on clique dessus la macro va chercher les champs en English (Colonne B) et les mettre à jour dans la Feuil2.
J'espère avoir été plus clair.
Fleaa
Sub transpose()
Dim dl&
Application.CutCopyMode = False
dl = Feuil1.Cells(Rows.Count, 1).End(3).Row
Feuil1.Activate
Feuil1.Range(Cells(3, 2), Cells(dl, 2)).Copy
Feuil2.Activate
Feuil2.Cells(1, 1).PasteSpecial Paste:=xlValue, transpose:=True
Application.CutCopyMode = True
End Subun exemple possible de macro pour lire les données de la colonne B.
Pour la colonne C, il suffit de remplacer le 2 par le 3 dans l'expression :
Feuil1.Range(Cells(3, 2), Cells(dl, 2)).CopySalutations et bon courage pour l'adaptation.
Re Excelator,
J'ai une erreur sur la ligne
dl = Feuil1.Cells(Rows.Count, 1).End(3).Row"Erreur d'exécution 424 - Objet requis"
Fleaa
Bonsoir bernard22,
Le problème c'est que je peux avoir plusieurs centaines de mots. Il faut donc que ça soit paramétrable.
Fleaa
il faut remplacer "Feuil1" par le nom de la feuille en question...Donc sheets("nom_de_la_feuillle").Cells(Rows.Count, 1).End(3).Row
SALUT
essayer ca :
Sub test()
Dim f1, f2
Dim dercol As Integer, i As Integer, x As Integer
Dim T As Variant, ltr As String, ltr2 As String, nb As Integer
Set f1 = Worksheets("Feuil1")
Set f2 = Worksheets("Feuil2")
dercol = f2.Cells(1, Columns.Count).End(xlToLeft).Column
If ActiveSheet.Shapes(1).TextFrame.Characters.Text = "Français" Then
ltr = "B"
ltr2 = "C"
ActiveSheet.Shapes(1).TextFrame.Characters.Text = "Anglais"
ElseIf ActiveSheet.Shapes(1).TextFrame.Characters.Text = "Anglais" Then
ltr = "C"
ltr2 = "B"
ActiveSheet.Shapes(1).TextFrame.Characters.Text = "Français"
End If
nb = f1.Range(ltr & Rows.Count).End(xlUp).Row
For x = 1 To dercol
For i = 1 To nb
If Not f2.Cells(1, x).Value = "" Then
Set T = f1.Range(ltr & 3 & ":" & ltr & nb).Find(f2.Cells(1, x).Value)
If Not T Is Nothing Then
f2.Cells(1, x).Value = f1.Range(ltr2 & T.Row).Value
End If
End If
Next
Next
End SubSalut AMIR,
C'est exactement ce que je voulais, je te remercie ! Je remarque cependant un problème : quand je rajoute des champs dans ma Feuil1 ça ne les rajoute pas dans la Feuil2.
Y a t'il un paramètre à modifier dans le code ?
Fleaa
BONSOIR
a copier dans la feuille 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim f1, f2
Dim dercol As Integer, i As Integer, x As Integer
Dim ltr As String, ltr2 As String, nb As Integer
Set f1 = Worksheets("Feuil1")
Set f2 = Worksheets("Feuil2")
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Or _
Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
dercol = f2.Cells(1, Columns.Count).End(xlToLeft).Column
f2.Range(f2.Cells(1, 1), f2.Cells(1, dercol)).ClearContents
If f2.Shapes(1).TextFrame.Characters.Text = "Français" Then
nb = f1.Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To nb - 2
f2.Cells(1, i).Value = f1.Range("B" & i + 2).Value
Next
ElseIf f2.Shapes(1).TextFrame.Characters.Text = "Anglais" Then
nb = f1.Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To nb - 2
f2.Cells(1, i).Value = f1.Range("C" & i + 2).Value
Next
End If
End If
End Sub Bonjour,
Je te laisse développer avec des macros, ça me plait aussi. Pour ton info, la solution par formule est parmétrable ( noms dynamiques), et multilingues si besoin.
Bonjour AMIR,
Encore merci pour ton aide !
Pourrais tu m'envoyer une version de ton code mais commentée si cela ne te dérange pas pour que je puisse bien comprendre ce que tu as fait.
Merci d'avance.
Fleaa
bonjour
Private Sub Worksheet_Change(ByVal Target As Range) 'Cet événement se produit lorsque des cellules d'une feuille de calcul sont modifiées par l'utilisateur ou par un lien externe
'decllarations des variabe :
Dim f1, f2
Dim dercol As Integer, i As Integer, x As Integer
Dim ltr As String, ltr2 As String, nb As Integer
'Sort de réduction :
Set f1 = Worksheets("Feuil1")
Set f2 = Worksheets("Feuil2")
'par exemple a la place de
'Worksheets("Feuil1").Range("B2").Value on ecrit : f1.Range("B2").Value
' On cherche la cellule qui a été modifié dans les colonne suivantes :
' Range("B:B") => colonne B Range("C:C") => colonne B
If Not Application.Intersect(Target, Range("B:B")) Is Nothing Or _
Not Application.Intersect(Target, Range("C:C")) Is Nothing Then
' dercol = derniere cellule non vide sur la ligne des mots dans "Feuil2"
dercol = f2.Cells(1, Columns.Count).End(xlToLeft).Column
f2.Range(f2.Cells(1, 1), f2.Cells(1, dercol)).ClearContents
' Shapes => form libre ou bouton ....
If f2.Shapes(1).TextFrame.Characters.Text = "Français" Then 'pour modifier le text dans le bouton (basculer entre "Français" et "anglais"
nb = f1.Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To nb - 2
f2.Cells(1, i).Value = f1.Range("B" & i + 2).Value
Next
ElseIf f2.Shapes(1).TextFrame.Characters.Text = "Anglais" Then 'pour modifier le text dans le bouton (basculer entre "Français" et "anglais"
' nb = derniere cellule non vide sur une des colonnes des mots dans "Feuil1"
nb = f1.Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To nb - 2 'boucle
f2.Cells(1, i).Value = f1.Range("C" & i + 2).Value
Next
End If
End If
End SubSalut AMIR,
J'aimerais faire la même chose sauf que le bouton "Francais-Anglais" sera dans une autre feuille (Feuil3 par exemple).
J'ai essayé à multiples reprises mais je n'y arrive toujours pas.
Pourrais tu m'aider stp ?
Merci d'avance.
Fleaa
Re AMIR,
Je voulais si tu t'étais penché sur mon problème ?
Fleaa