XL 2016 [Resolu]Fond de couleur de la cellule en fonction du texte choisi

[nrdz83]

Bonjour,
je cherche à mettre en couleur le fond d'une cellule en fonction du choix d'une liste déroulante.

La couleur serait celle de la colonne F de l'onglet données.

Par avance je vous remercie pour votre aide.

Bonne journée

Cordialement.

 

[Phil69970]

Bonjour @nrdz83

Je te propose ce fichier

A noter : Tu peux rajouter le nombre de valeur/couleur dans la feuille "Données"

Merci de ton retour

 

[wDog66]

Bonjour Nrdz83, Phil69970 😉

Je changerais juste une petite chose par rapport au code donné par Phil

Worksheets("Feuil1").Range("G4").Interior.Color = Ws2.Range("F" & NumLig).Interior.Color

Sinon, certaines couleurs ne sont pas respectées

A+

 

[Phil69970]

Bonjour @wDog66

Je pensais que colorindex "renvoyait" mieux les couleurs que color simple

 

[wDog66]

Bonjour @wDog66

Je pensais que colorindex "renvoyait" mieux les couleurs que color simple

Une petite idée ICI de la différence 😜

Ce qu'il faut retenir :
- ColorIndex = 56 couleurs basiques
- Color = toutes les couleurs

 

[Phil69970]

@wDog66

J'ai modifié le fichier pour en tenir compte 😉

 

[mapomme]

Bonjour à tous,

Exécuter le code suivant pour une feuille vierge. Vous verrez que des couleurs différentes à l'œil peuvent avoir un même colorindex alors que color a des valeurs différentes.

Sub test()
Dim i&
   [a1] = "Couleur": [b1] = "RGB (Color)": [c1] = "ColorIndex"
   For i = 2 To 15
      Cells(i, 1).Interior.Color = RGB(10 * i, 100, 200)
      Cells(i, 2) = Cells(i, 1).Interior.Color & " - RGB(" & Join(Array(10 * i, 0, 0), " , ") & ")"
      Cells(i, 3) = Cells(i, 1).Interior.ColorIndex
      Columns("a:c").ColumnWidth = 25
      Columns("a:c").HorizontalAlignment = xlCenter
      [a1].CurrentRegion.Borders.LineStyle = xlContinuous
   Next i
End Sub

 

[nrdz83]

Bonjour Phil69970 et wDog66,et mapomme

un grand merci pour votre aide précieuse.

Je vous souhaite un bon week end

AMitiés

 

[Phil69970]

Bonjour @mapomme

J'ai vu 😉

 

[job75]

Bonjour à tous,

@Phil69970 et le bug quand on efface G4 ???

A+

 

[Phil69970]

Bonjour Gérard

Il faut juste rajouter ceci avant de tester "intersect"

If Ws1.Range("G4") = "" Then Exit Sub

 

[mapomme]

re,
Un autre code pour ne pas avoir d'erreur à l'effacement ::

Sub Worksheet_Change(ByVal Target As Range)
Dim lig&
   If Intersect(Target, Worksheets("Feuil1").[G4]) Is Nothing Then Exit Sub
   Target.Interior.ColorIndex = xlColorIndexAutomatic
   lig = Application.IfError(Application.Match(Target, Worksheets("Données").Columns("e:e"), 0), 0)
   If lig > 0 Then Target.Interior.Color = Worksheets("Données").Cells(lig, "f").Interior.Color
End Sub

 

[job75]

Sub Worksheet_Change(ByVal Target As Range)
Dim Ws1 As Worksheet, Ws2 As Worksheet, i As Variant

Set Ws1 = Worksheets("Feuil1")
Set Ws2 = Worksheets("Données")

i = Application.Match(Ws1.Range("G4"), Ws2.Columns("E"), 0)
If IsNumeric(i) Then Ws1.Range("G4").Interior.Color = Ws2.Range("F" & i).Interior.Color
End Sub