Choisir la couleur d'une cellule sous Excel

Salut,

Je viens de passer du temps pour trouver la solution (car je n'ai pas rester sur une question sans réponse) et je pense que j'ai trouvé : il n'y a pas de solution.

Je m'explique. Voici le code qui pourrait marcher :

Public Sub coloreCellule()
    Dim lig As Integer
    Dim maCouleur As String
    
    For lig = 2 To 15
        
        maCouleur = Range(Cells(lig, 2), Cells(lig, 2)).Value
        rouge = Mid(maCouleur, 1, 2)
        vert = Mid(maCouleur, 3, 2)
        bleu = Mid(maCouleur, 5, 2)
        
        r = CInt("&H" & rouge)
        g = CInt("&H" & vert)
        b = CInt("&H" & bleu)
        
        Range(Cells(lig, 4), Cells(lig, 4)).Interior.Color = RGB(r, g, b)

    Next lig
    
End Sub

Mais les couleurs de remplissage des cellules doivent être situées dans la palette de excel (56 couleurs je crois).

Une ligne de code permet de tester ce que je viens de dire. Il suffit d'exécuter la macro suivante :

Public Sub test_couleur_hexa()
    maCouleur = &H339966
    Range(Cells(16, 1), Cells(16, 4)).Interior.Color = &H339966     ' Vert pale
    Range(Cells(17, 1), Cells(17, 4)).Interior.Color = &H808570     ' Pas dans la palette
End Sub

La deuxième ligne de code va colorer les 4 cellules en utilisant la couleur de la palette la plus proche. Je pense que le mieux est donc d'utiliser comme tu l'as fait un objet shape. Pour améliorer le code, il faudrait peut-être en faire une macro qui supprime l'ancien shape avant d'en mettre un nouveau, ce qui ferait une feuille excel toujours propre.

Avant de finir, voici une page qui traite de manière exhaustive des couleurs dans excel :
http://dmcritchie.mvps.org/excel/colors.htm

Voilà, je pense que ça doit pourvoir aider certaine personne qui se posait la même question que moi

Vincent

Bonsoir c'est d'un RAL utilisé en peinture dont tu parles ?
tu as combien de lignes de couleur ?
il existe bien une palette de couleurs sous Excel mais peut-être pas avec autant de nuances
vois à droite dans "ressources autour de ce sujet "...

sinon , tu cliques dans une cellule , format, motifs et dans motifs encore motif une deuxième palette s'ouvre et tu cliques

Bonjour,

En fait je me suis mal exprimé : je veux automatiquement modifier la couleur d'une cellule en VBA à partir
d'une couleur définie en hexadécimal dont la valeur se trouve dans une autre cellule.

Bonsoir tout le monde,
et un ;-) à xkristi... c'est quoi un RAL au fait ?

Essaie si ça correspond à ce que tu veux.
Je ne colore pas la cellule (moins de couleurs) mais je dessine un rectangle à la dimension de la cellule à droite de ta selection.
Si tu lances plusieurs fois la macro pense à supprimer les objets qui s'empilent.
Tu peux sélectionner autant de cellules que tu veux avant de lancer la macro.
Le n° de couleur doit être écrit tel que l'as mis (3 octets en hexa).
La gestion d'erreur est minimum.

Sub couleur()
    For Each cel In Selection
        Dim x As Single, y As Single, largeur As Single, hauteur As Single
        Dim r As Integer, g As Integer, b As Integer
        On Error GoTo erreur
        x = cel.Offset(0, 1).Left
        y = cel.Offset(0, 1).Top
        largeur = cel.Offset(0, 1).Width
        hauteur = cel.Offset(0, 1).Height
        r = CInt("&H" & Left(cel.Value, 2))
        g = CInt("&H" & Mid(cel.Value, 3, 2))
        b = CInt("&H" & Right(cel.Value, 2))
        ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, largeur, hauteur).Fill.ForeColor.RGB = RGB(r, g, b)
erreur:
    Next cel
End Sub

eric

Bonsoir

Je viens de tester le code, transformé pour l'occasion en fonction avec comme paramètre l'adresse de la cellule qui
contient la couleur au format hexa et ça marche parfaitement !

Le Code :
Public Function setColor1(cel As Range)
Dim x As Single, y As Single, largeur As Single, hauteur As Single
Dim r As Integer, g As Integer, b As Integer
x = cel.Offset(0, 1).Left
y = cel.Offset(0, 1).Top
largeur = cel.Offset(0, 1).Width
hauteur = cel.Offset(0, 1).Height
r = CInt("&H" & Left(cel.Value, 2))
g = CInt("&H" & Mid(cel.Value, 3, 2))
b = CInt("&H" & Right(cel.Value, 2))
ActiveSheet.Shapes.AddShape(msoShapeRectangle, x, y, largeur, hauteur).Fill.ForeColor.RGB = RGB(r, g, b)
End Function

Merci pour cette astuce !

Bonne Continuation

Vincent

Parfait...
Si au hasard de ton travail tu trouves comment indiquer la couleur directement en hexa poste ici, j'ai cherché et pas trouvé.
Merci
Bonne soirée
eric

Bonjour,

C'est pour cela que j'avais utilisé un objet et non les cellules, pouvoir afficher toutes les couleurs.
Pour ce qui est de supprimer les objets s'il faut tous les contrôler, regarder leur type, leurs position et taille pour les effacer ça risque d'etre un peu lourd pour l'usage...
Sinon tu peux ajouter
Worksheets("feuil1").DrawingObjects.Delete
avec une demande de confirmation pour effacer TOUS les objets de la feuille.

eric