Macro Changement de couleur

Fernand -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention - 6 avril 2013 à 09:07

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

Afficher la suite

A voir également:

Macro Changement de couleur
Changer de dns - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Excel cellule couleur si condition texte - Guide
Boite a couleur - Télécharger - Divers Photo & Graphisme
Changer la couleur de la barre des taches - Guide

4 réponses

Réponse 1 / 4

Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention 5 135

Salut,

Tu peux faire plus simple, regarde ce fichier joint

https://www.cjoint.com/?CDfk1ZZds81

Réponse 2 / 4

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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

Bonjour Michel,
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 ?

Réponse 3 / 4

Fernand

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.

Réponse 4 / 4

Fernand

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 ?

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

bonjour,

dans quelle solution ????

en ce qui me concerne, manquait un point
Select Case cible
Case Is = "Vac"
.ColorIndex = 1
et j'ai testé: ca fonctionne

Discussions similaires

sertissage des cables rj45

couleur personnage

Couleur transparente

Votre réponse

Discussions similaires