MEF conditionnelle par VB, j'ai ma formule mais...

[nak]

Bonjour à tous

J'ai une formule de mise en forme conditionnelle mais je n'arrive pas à l'adapter à ma feuille.
Pour résumer je veux mettre en forme ma cellule A4 suivant la valeur en H4.
Voici le code

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If ("papier!H4") = 1 Then
Dim Couleur As Integer, I As Integer, R As Long
R = ("papier!A4")
Select Case UCase(Target)
Case "1": Couleur = 6
Target.Interior.ColorIndex = Couleur
Case "2": Couleur = 4
Target.Interior.ColorIndex = Couleur
Case "3": Couleur = 45
Target.Interior.ColorIndex = Couleur
Case "4": Couleur = 38
Target.Interior.ColorIndex = Couleur
Case "5": Couleur = 33
Target.Interior.ColorIndex = Couleur
Case "6": Couleur = 13
Target.Interior.ColorIndex = Couleur
Case "7": Couleur = 3
Target.Interior.ColorIndex = Couleur
Case Else: Couleur = 0
End Select
End If
End Sub

Je joins aussi un petit classeur

Pouvez vous me dépanner SVP

Merci

 

[mécano41]

Re : MEF conditionnelle par VB, j'ai ma formule mais...

Bonjour,

comme ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Couleur As Integer
If Not Intersect(Range("H4"), Target) Is Nothing Then
Select Case Target
Case "1": Couleur = 6
Case "2": Couleur = 4
Case "3": Couleur = 45
Case "4": Couleur = 38
Case "5": Couleur = 33
Case "6": Couleur = 13
Case "7": Couleur = 3
Case Else: Couleur = 0
End Select
Target.Interior.ColorIndex = Couleur              ' ligne à supprimer si H4 ne doit pas prendre la couleur
Range("A4").Interior.ColorIndex = Couleur
End If
End Sub

NOTA : la couleur 6 doit ^tre changée ou bien il faut mettre une couleur différente d'écriture pour ce "Case"

Cordialement

 

[nak]

Re : MEF conditionnelle par VB, j'ai ma formule mais...

Merci pour ta réponse très rapide, cela fonctionne mais je rencontre un autre problème...

J'ai oublié de dire que dans ma cellule H4 il y avait la formule =DROITE(A4;1)

Comment contourner le problème ?

Merci

 

[mécano41]

Re : MEF conditionnelle par VB, j'ai ma formule mais...

Voilà, avec des lettres + un chiffre en dernier dans A4

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Couleur As Integer
If Not Intersect(Range("A4"), Target) Is Nothing Then
Select Case Range("H4")
Case "1": Couleur = 6
Case "2": Couleur = 4
Case "3": Couleur = 45
Case "4": Couleur = 38
Case "5": Couleur = 33
Case "6": Couleur = 13
Case "7": Couleur = 3
Case Else: Couleur = 0
End Select
Range("H4").Interior.ColorIndex = Couleur     ' ligne à supprimer si H4 ne doit pas prendre la couleur
Range("A4").Interior.ColorIndex = Couleur
End If
End Sub

Cordialement

 

[nak]

Re : MEF conditionnelle par VB, j'ai ma formule mais...

Merci mais cela ne fonction pas, je joins mon fichier

Merci encore

 

[mécano41]

Re : MEF conditionnelle par VB, j'ai ma formule mais...

Si tu modifies au fur et à mesure, cela ne peut pas marcher 😀 !

Voici ton fichier modifié ; dis-moi si cela fait tout comme tu veux.

Cordialement