Ecrire un texte en fonction d'une couleur spécifique (codeRGB)

Bonjour/Bonsoir,

Je suis un néophyte complet (en code et Excel). d'où le code suivant qui symbolise bien mon absence de compétence., Merci d'avance

    If Cells("A").Interior.Color = RGB(217, 217, 217) Then Cells("Y").Value = "ENVOYE"
    If Cells("A").Interior.Color = RGB(204, 255, 204) Then Cells("Y").Value = "PRET"
    If Cells("A").Interior.Color = RGB(255, 255, 0) Then Cells("Y").Value = "QC"
    If Cells("A").Interior.Color = RGB(146, 208, 80) Then Cells("Y").Value = "EN PRODUCTION"
    If Cells("A").Interior.Color = RGB(184, 204, 228) Then Cells("Y").Value = "ENREGISTRE"
    ELSE Cells("Y").Value = ""

Je cherche a obtenir un mot que je "paramètre" dans la cellule colonne Y en fonction de la couleur de fond de la cellule de la colonne A qui est sur la même ligne.

En gros si A1 est en jaune alors écrire QC en Y1, si A33 est gris alors écrire ENVOYE dans Y33... et cela pour un ensemble de ligne variable selon mes besoins, don un programme non basé sur une plage de données fixe (hormis le bornage des colonnes)

Même si mon fichier ne contient qu'une base de travail, ce sont bien ces colonnes spécifique que je veux. Les codes 5 RGB sont spécifiques ainsi que les 5 mots

Merci d'avance de votre aide,

PS:Je n'y connait rien mais est t-il possible d'incorporé un "stop" si sur 5 ligne consécutive ne sont pas des 5 couleurs? est ce nécessaire ?

Salut,

C'est moins évident d'aller "lire" une valeur "RGB" qu'une valeur ''Color''. Je te propose donc la macro ci-jointe.

Cordialement.

bonsoir,

Sub sjsjs()
     Dim i     As Integer

     Range("Y:Y").ClearContents

     For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
          With Range("Y" & i)
               Select Case Range("A" & i).Interior.Color
                    Case RGB(217, 217, 217): .Value = "ENVOYE"
                    Case RGB(204, 255, 204): .Value = "PRET"
                    Case RGB(255, 255, 0): .Value = "QC"
                    Case RGB(146, 208, 80): .Value = "EN PRODUCTION"
                    Case RGB(184, 204, 228): .Value = "ENREGISTRE"
                    Case Else: .Value = ""
               End Select
          End With
     Next i
End Sub

Merci, c'est ce qu'il me fallait @BsALv et @Yvouille !

Sub sjsjs()
     Dim i     As Integer

     Range("Y:Y").ClearContents

     For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
          With Range("Y" & i)
               Select Case Range("A" & i).Interior.Color
                    Case RGB(217, 217, 217): .Value = "ENVOYE"
                    Case RGB(204, 255, 204): .Value = "PRET"
                    Case RGB(255, 255, 0): .Value = "QC"
                    Case RGB(146, 208, 80): .Value = "EN PRODUCTION"
                    Case RGB(184, 204, 228): .Value = "ENREGISTRE"
                    Case Else: .Value = ""
               End Select
          End With
     Next i
End Sub

La version de de BsALv me convient mieux avec la possibilité de modifier les RGB en prenant les valeurs, ou d'ajouter de nouvelle lignes. En effet ce fichier sera transmis au sein d'une équipe de travail avec aucune personne maniant la programmation(d'où la facilité de trouver les Valeurs RGB cf image) Un simple mode opératoire de modification et d'explication devrait suffire.

Encore merci, et il ne me reste plus qu'à planifier du temps pour me former sur VBA. L'urgence de la situation m'a contraint a vous demander de l'aide mais je vous avoue être plus emballé a l'idée d'expérimenter par moi même (et pouvoir un jour vous rendre la pareille )

SUJET CLOS

bonjour, en 2010 le valeur hexadecimal n'était pas encore en dessous.

alors une solution avec un tableau avec en droite du tableau une formule qui calcule cette valeur hexadecimal.

Maintenant, ils n'ont qu'à modifier le tableau et ils ne doivent plus changer quelque chose en VBA

Sub MesCouleurs()

     Range("Y:Y").ClearContents
     arr5 = Range("TBL_Couleurs").Columns(5).Value
arr1 = Range("TBL_Couleurs").Columns(1).Value

     For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
          x = Right("000000" & WorksheetFunction.Dec2Hex(Range("A" & i).Interior.Color), 6)
          r = Application.Index(arr1, Application.Match(x, arr5, 0))
          If IsError(r) Then r = "erreur"
          Range("Y" & i).Value = r
     Next i
End Sub