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 "...
xkristi
Tu ne perds jamais ton temps quand tu t'amuses ...

Sinon , tu cliques dans une cellule , format, motifs et dans motifs encore motif une deuxième palette s'ouvre et tu cliques
xkristi
Tu ne perds jamais ton temps quand tu t'amuses ...

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

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

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

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

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