Macro Changement de couleur

Question

Bonjour à vous tous,

Je sollicite votre aide car mon code ne fonctionne pas du tout et en plus il me semble qu'il y aurait une façon plus simple d'y arriver.

Ce que je cherche à faire, je le fais déjà avec mise en forme conditionnelle, mais je suis rendu déjà rendu à 4 choix de couleur.

si(a1)=1;mettre(A1:A3)de tel couleur;si(a1)=2;mettre(A1:A3)de tel couleur;..etc.

J'ai dans mon tableau 17 casé qui peut changer de valeur et ceux-ci provient d'une autre feuille ça risque d'être d'une longueur excessif.
Voici le code que j'ai pensé mais comme je vous dis il ne fonctionne pas correctement.

Merci de votre aide.

Sub worksheet_change(ByVal target As Range)
    If Not Intersect(target, Range("a1")) Is Nothing Then
On Error Resume Next
    If Worksheets(1).Range.Value("a1") = "Vac" _
    Then Worksheets(1).Range("a1:a3").Interior.ColorIndex = 1
    If Worksheets(1).Range.Value("a1") = "For" _
    Then Worksheets(1).Range("a1:a3").Interior.ColorIndex = 2
    If Worksheets(1).Range.Value("a1") = "Pre" _
    Then Worksheets(1).Range("a1:a3").Interior.ColorIndex = 3
    If Worksheets(1).Range.Value("a1") = "Mal" _
    Then Worksheets(1).Range("a1:a3").Interior.ColorIndex = 4
ElseIf Not Intersect(target, Range("b1")) Is Nothing Then
    If Worksheets(1).Range.Value("b1") = "Vac" _
    Then Worksheets(1).Range("b1:b3").Interior.ColorIndex = 1
    If Worksheets(1).Range.Value("b1") = "For" _
    Then Worksheets(1).Range("b1:b3").Interior.ColorIndex = 2
    If Worksheets(1).Range.Value("b1") = "Pre" _
    Then Worksheets(1).Range("b1:b3").Interior.ColorIndex = 3
    If Worksheets(1).Range.Value("b1") = "Mal" _
    Then Worksheets(1).Range("b1:b3").Interior.ColorIndex = 4
ElseIf Not Intersect(target, Range("c1")) Is Nothing Then
    If Worksheets(1).Range.Value("c1") = "Vac" _
    Then Worksheets(1).Range("c1:c3").Interior.ColorIndex = 1
    If Worksheets(1).Range.Value("c1") = "For" _
    Then Worksheets(1).Range("c1:c3").Interior.ColorIndex = 2
    If Worksheets(1).Range.Value("c1") = "Pre" _
    Then Worksheets(1).Range("c1:c3").Interior.ColorIndex = 3
    If Worksheets(1).Range.Value("c1") = "Mal" _
    Then Worksheets(1).Range("c1:c3").Interior.ColorIndex = 4
ElseIf Not Intersect(target, Range("d1")) Is Nothing Then
    If Worksheets(1).Range.Value("d1") = "Vac" _
    Then Worksheets(1).Range("d1:d3").Interior.ColorIndex = 1
    If Worksheets(1).Range.Value("d1") = "For" _
    Then Worksheets(1).Range("d1:d3").Interior.ColorIndex = 2
    If Worksheets(1).Range.Value("d1") = "Pre" _
    Then Worksheets(1).Range("d1:d3").Interior.ColorIndex = 3
    If Worksheets(1).Range.Value("d1") = "Mal" _
    Then Worksheets(1).Range("d1:d3").Interior.ColorIndex = 4
End If
End Sub

Mike-31 · Answer

Salut,

Tu peux faire plus simple, regarde ce fichier joint

https://www.cjoint.com/?CDfk1ZZds81

michel_m · Answer

Bonjour   

autre méthode VBA uniquement   

Private Sub Worksheet_Change(ByVal Target As Range)   
Dim Adresse As String   
If Not Intersect(Target, Range("A1:D1")) Is Nothing Then   
     Adresse = Target.Address   
     Select Case Adresse   
          Case Is = "$A$1"   
               colorier Target, "A1:A3"   
          Case Is = "$B$1"   
               colorier Target, "B1:B3"   
          '.... à complèter   
     End Select   
End If   

End Sub   

'------------------------  

Sub colorier(cible, plage)   
     With Sheets(1).Range(plage).Interior   
          Select Case cible   
               Case Is = "Vac"   
                  ColorIndex = 1   
               Case Is = "For"   
                     .ColorIndex = 2   
               Case Is = "Pre"   
                     .ColorIndex = 3   
               Case Is = "Mal"   
                    .ColorIndex = 4   
               Case Else   
                    MsgBox "erreur de saisie", vbCritical   
                    Exit Sub   
          End Select   
     End With   
End Sub   
    

attention , sensible à la casse mais facilement adaptable   
Select case Ucase(cible)   
     Case is ="VAC"   
etc.   
 Michel

Fernand · Answer

Merci à vous tous d'avoir pris le temps de m'aider et c'est grandement apprécié, je test le tous ce soir et je vous redonne des nouvelles bientôt.

Merci.

Fernand · Answer

Bonjour à tous,
Merci pour vos réponse.

La macro fonctionne bien, mais la mise à jour ne se fait pas, probablement dû au fait que l'information de la cellule provient d'une autre feuille. 

Avez-vous une idée ou une solution ?

Macro Changement de couleur

4 réponses

Discussions similaires

Newsletters