Convertisseur

Tywan

XLDnaute Nouveau
Salut!

J'aimerai savoir comment faire pour que 2 cellules se répondent mutuellement.
Une cellule indique un poids en kg, la deuxième en lbs.
Quand je rentre un poids dans la cellule kg je multiplie par 2,2046244 pour avoir le poids en lbs dans la deuxième.
Malheureusement, parfois le poids sont donnés en lbs et doivent donc être convertis en kg.
Je ne peux pas entrer une formule dans une cellule qui est déjà le résultat d'une somme.

Comment faire pour que si le rentre les kg l’obtienne les lbs et vis et versa?
 

Pierrot93

XLDnaute Barbatruc
Re : Convertisseur

Bonjour à tous,

tes kgs en cellule A1, les lbs en cellule B1, code à placer dans le module de la feuille concernée :
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application
    If Not .Intersect(Target, Range("A1:B1")) Is Nothing Then
        .EnableEvents = False
        If Not IsEmpty(Target) Then _
            Cells(1, IIf(Target.Column = 1, 2, 1)).Value _
            = Evaluate(Target & Choose(Target.Column, "/", "*") & 2.2046244)
        .EnableEvents = True
    End If
End With
End Sub

sans plus de détails...

bonne journée
@+
 

Tywan

XLDnaute Nouveau
Re : Convertisseur

J'ai mis le document en pièce jointe.
Le but est de faire des stickers regroupant certaines informations.
Sur l'exemple il faudrait que la cellule F13 et O13 se répondent.
Merci pour vos formule mais je n’arrive pas à les rentrer.

De plus si vous pouvez me dire comment faire pour , au cas où je coche la case B16, toutes les autres cases de la même feuille fassent de même mais que si elle n'est pas cochée ça ne soit pas un 0 qui apparaissent sur les autres.

Merci pour votre aide!!!
 

Pièces jointes

  • Label.xlsx
    29.5 KB · Affichages: 79
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Convertisseur

Re,

s'il s'agit des cellules O13 et F13....
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application
    If Not .Intersect(Target, Range("F13,O13")) Is Nothing Then
        .EnableEvents = False
        If Not IsEmpty(Target) Then _
            Cells(13, IIf(Target.Column = 6, 15, 6)).Value _
            = Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
        .EnableEvents = True
    End If
End With
End Sub

pour placer le code, click droit sur l'onglet => visualiser le code et tu colles dans la fenêtre qui s'ouvre... attention le classeur doit prendre en charge les macros.... ce qui n'est pas le cas des fichiers xlsx... utiliser un xlsm.... perso pas 2007 sous le coude....
 

Tywan

XLDnaute Nouveau
Re : Convertisseur

Excellent!!! La formule marche nickel...
Je ne sais pas si tu as ouvert le fichier que j'ai mis mais il y a plusieurs stickers sur la même feuille.
Cette formule soit donc être répétée plusieurs fois.
J'ai essayé de faire un copier coller en changeant juste les cellules, mais ça m'indique une erreur.
"Ambiguous name detected: Worksheet_Change"

Dois-je faire autrement pour l'appliquer a d'autres cellules?
 

Pierrot93

XLDnaute Barbatruc
Re : Convertisseur

Re,

pas ouvert ton fichier, pas 2007 à dispo... A noter sur une feuile de calcul tu ne peux avoir qu'une procédure "Worksheet_Change"... il faut modifier la plage :
Code:
If Not .Intersect(Target, Range("F13,O13")) Is Nothing Then
et modifier le reste en conséquence.....
 

Tywan

XLDnaute Nouveau
Re : Convertisseur

Pour info, j'ai modifier la formule pour que ça fonctionne dans toutes les parties voulues.
Ça donne ça:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application
If Not .Intersect(Target, Range("F13,O13")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(13, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("AA13,AJ13")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(13, IIf(Target.Column = 27, 36, 27)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("F35,O35")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(35, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("AA35,AJ35")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(35, IIf(Target.Column = 27, 36, 27)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("F57,O57")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(57, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("AA57,AJ57")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(57, IIf(Target.Column = 27, 36, 27)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("F79,O79")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(79, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("AA79,AJ79")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(79, IIf(Target.Column = 27, 36, 27)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("F101,O101")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(101, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)
.EnableEvents = True
End If
If Not .Intersect(Target, Range("AA101,AJ101")) Is Nothing Then
.EnableEvents = False
If Not IsEmpty(Target) Then _
Cells(101, IIf(Target.Column = 27, 36, 27)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "/", "*") & 2.2046244)
.EnableEvents = True
End If
End With
End Sub

Mon souci est que une fois que j'enregistre le document en format xlsm (Excel Macro-Enable Worksheet), quand je l'ouvre à nouveau la formule est bien là, mais inactive...
Que faut-il faire pour qu'elle reste active???
 

Pierrot93

XLDnaute Barbatruc
Re : Convertisseur

Bonjour,

pour raccourcir un peu le code :
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
With Application
    If Not .Intersect(Target, Range("F13,O13,AA13,AJ13,F35,O35,AA35,AJ35,F57,O57," _
        & "AA57,AJ57,F79,O79,AA79,AJ79,F101,O101,AA101,AJ10")) Is Nothing Then
        .EnableEvents = False
        If Not IsEmpty(Target) Then _
            Cells(Target.Row, Switch(Target.Column = 6, 15, Target.Column = 15, 6, _
            Target.Column = 27, 36, Target.Column = 36, 27)).Value _
            = Evaluate(Target & IIf(Target.Column = 6 Or Target.Column = 27, "/", "*") & 2.2046244)
        .EnableEvents = True
    End If
End With
End Sub

pour l'activation des macros sous 2007 regarde du coté des options de sécurité.... comme déjà dit, perso pas 2007 sous le coude...

bonne journée
@+
 

Tywan

XLDnaute Nouveau
Re : Convertisseur

Bonjour,

je reviens vers vous avec ce code car je viens de changer de PC et lorsque j'essaie de réutiliser ce code il m'indique:

Run-time error '13':
Type mismatch

lorsque j'essaie de "debugger", les erreurs se mettent sur cette ligne:

Cells(57, IIf(Target.Column = 6, 15, 6)).Value _
= Evaluate(Target & Choose((Target.Column Mod 2) + 1, "*", "/") & 2.2046244)

Pouvez vous m'aider?


Pour info, ce code marche bien sur d'autres PC...
 

Pierrot93

XLDnaute Barbatruc
Re : Convertisseur

Bonjour,

A tout hasard, regarde si tu n'as pas une référence topée "MANQUANTE", dans l'éditeur VBA => barre de menu => outils => références, si c'est le cas décoches la, ferme en enregistrant le fichier et ré-ouvre le...

bon après midi
@+
 

Tywan

XLDnaute Nouveau
Re : Convertisseur

Bonjour Pierrot,

mais je ne trouve pas l'outil référence dont tu parles.

je te met des copies d’écran des différents onglets que j'ai pour que tu puisses m'indiquer où les trouver.

home.jpg

Data.jpg

review.jpg

View.jpg

Je suis limité à 4 photos, j’espère au moins que ça fait parti des onglets sélectionnés... :)

Merci pour ton aide.
 

Discussions similaires

Réponses
10
Affichages
351

Statistiques des forums

Discussions
312 839
Messages
2 092 682
Membres
105 509
dernier inscrit
hamidvba