Couleur de remplissage selon valeur d'une autre cellule
I
Bonjour,
Je recherche un code permettant lorsque j'appelle la macro :
- Applique dans la feuille "Rapport" pour les cellules A1 à A500 les couleurs dont le code hexadécimal est la valeur sur la feuille "ref_couleur"Concrètement
La couleur de remplissage de Rapport!A1 est la valeur en hexadécimale de Ref_couleur!A1
La couleur de remplissage de Rapport!A2 est la valeur en hexadécimale de Ref_couleur!A2
La couleur de remplissage de Rapport!A3 est la valeur en hexadécimale de Ref_couleur!A3
Ainsi jusqu'a A500
Espérant être compréhensible
Merci pour votre aide
Bonjour,
Un essai (non testé) :
Sub AppliquerCouleursHexa()
Dim Lig As Long
For Lig = 1 To 500
If Len(Sheets("Ref_couleur").Range("A" & Lig)) > 0 Then Sheets("Rapport").Range("A" & Lig).Interior.Color = hexa_color(Sheets("Ref_couleur").Range("A" & Lig))
Next Lig
End Sub
Function hexa_color(ByVal hexa) 'Renvoie -1 en cas d'erreur
'Conversion de couleurs hexadécimales en valeur Color - Excel-Pratique.com
'www.excel-pratique.com/fr/astuces_vba/fonction-excel-conversion-hexa-color
hexa = Right(hexa, 6) 'Si code couleur avec #
If Len(hexa) = 6 Then
tab_valeurs = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", "b", "c", "d", "e", "f")
For i = 0 To 15
If (LCase(Mid(hexa, 1, 1)) = tab_valeurs(i)) Then position1 = i
If (LCase(Mid(hexa, 2, 1)) = tab_valeurs(i)) Then position2 = i
If (LCase(Mid(hexa, 3, 1)) = tab_valeurs(i)) Then position3 = i
If (LCase(Mid(hexa, 4, 1)) = tab_valeurs(i)) Then position4 = i
If (LCase(Mid(hexa, 5, 1)) = tab_valeurs(i)) Then position5 = i
If (LCase(Mid(hexa, 6, 1)) = tab_valeurs(i)) Then position6 = i
Next
If IsEmpty(position1) Or IsEmpty(position2) Or IsEmpty(position3) Or IsEmpty(position4) Or IsEmpty(position5) Or IsEmpty(position6) Then
hexa_color = -1
Else
hexa_color = RGB(position1 * 16 + position2, position3 * 16 + position4, position5 * 16 + position6)
End If
Else
hexa_color = -1
End If
End FunctionI
Bonjour Pedro,
Merci beaucoup, cela fonctionne
Chapeau pour votre réactivité et votre écriture à l'aveugle !
Bonne journée
Merci de votre retour ! A noter que la fonction, qui constitue l'essentiel du code, n'est pas de moi... Donc partant de là ça va assez vite !