Microsoft 365 copie de couleur d'une cellule à une autre sous condition

virdg

XLDnaute Nouveau
bonjour a tous,
voila mon soucis;
sur ma feuille de calcul 1
j'ai une liste de nom de couleur dans une colonne A (chaque cellule a une couleur du nom de la couleur )
exemple : A1 : magenta (coloré en magenta) B1 : 1
A2 : cyan (coloré en cyan) B2 : 2
A3 : yellow (coloré en jaune) B3 : 3
etc etc (j'en ai plus de 450),
a chaque couleur est associé un chiffre dans la colonne B
sur ma feuille de calcul 2
je voudrais rentrer les valeurs se trouvant dans la colonne B de la feuille 1 et que la cellule se mettent de la même couleur
Autrement dit quand je rentre la valeur 1 je veux que la cellule se colore en magenta
" " " 2 " " cyan
" " " 3 " " yellow
etc etc
quelqu'un aurait il une idée ? merci
 

fanch55

XLDnaute Barbatruc
Bonjour,
Pourquoi décorréler le chiffre de la couleur ? Une seule colonne suffit .
Donnez un nom à l'ensemble de vos cellules de couleurs :
1677844313013.png


Code à placer dans celui de Feuil2 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, C As Range
For Each T In Target
    If Not Intersect(T, Columns("B")) Is Nothing Then
        Set c = [Colors].Find(T, , xlValues, xlWhole)
        If Not c Is Nothing Then T.Interior.Color = c.Interior.Color
    End If
Next
End Sub

1677844458007.png
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Dans le module Feuil2 (Feuil2) :
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim CelCoul As Range
   Set CelCoul = Feuil1.Cells(Target.Value, "A")
   Target.Interior.Color = CelCoul.Interior.Color
   Target.Font.Color = CelCoul.Font.Color
   Target.Font.Bold = True
   End Sub
450 couleurs différentes ça fait beaucoup !
Êtes vous sûr qu'elles se distinguent bien les unes des autres ?
J'aurais de quoi les définir automatiquement, sans table.
 
Dernière édition:

virdg

XLDnaute Nouveau
Bonjour.
Dans le module Feuil2 (Feuil2) :
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim CelCoul As Range
   Set CelCoul = Feuil1.Cells(Target.Value, "A")
   Target.Interior.Color = CelCoul.Interior.Color
   Target.Font.Color = CelCoul.Font.Color
   Target.Font.Bold = True
   End Sub
450 couleurs différentes ça fait beaucoup !
Êtes vous sûr qu'elles se distinguent bien les unes des autres ?
J'aurais de quoi les définir automatiquement, sans table.
bonjour et merci, oui elle se différencient bien les unes des autres et dans l'avenir j'en aurais encore plein d'autre. je suis coloriste chercheur de couleur pour des imprimeurs, en fait ces couleur sont une conversion RGB des valeurs Lab faites au spectrodensitomètre (oui c'est un peu technique).
j'ai fait des essais avec votre fichier joint, j'ai un petit soucis, une fois un chiffre inscrit dans une case je ne peux pas revenir en arrière (l'effacer par exemple et retrouver le cellule vierge)
 
Dernière édition:

virdg

XLDnaute Nouveau
Bonjour,
Pourquoi décorréler le chiffre de la couleur ? Une seule colonne suffit .
Donnez un nom à l'ensemble de vos cellules de couleurs :
Regarde la pièce jointe 1164727

Code à placer dans celui de Feuil2 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, C As Range
For Each T In Target
    If Not Intersect(T, Columns("B")) Is Nothing Then
        Set c = [Colors].Find(T, , xlValues, xlWhole)
        If Not c Is Nothing Then T.Interior.Color = c.Interior.Color
    End If
Next
End Sub

Regarde la pièce jointe 1164728
merci pour votre aide, par contre etant un peu newbie en la matiere je le mets ou le code ? c'est un module visual basic ? c'est une macro ?
vous avez un fichier a me donner pour que je vois un peu ?
merci bcp
 

Dranreb

XLDnaute Barbatruc
Bonjour.
j'ai fait des essais avec votre fichier joint, j'ai un petit soucis, une fois un chiffre inscrit dans une case je ne peux pas revenir en arrière (l'effacer par exemple et retrouver le cellule vierge)
Corrigez comme suit dans le module de l'objet Worksheet :
VB:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim CelCoul As Range
   If VarType(Target.Value) = vbDouble Then
      Set CelCoul = Feuil1.Cells(Target.Value, "A")
      Target.Interior.Color = CelCoul.Interior.Color
      Target.Font.Color = CelCoul.Font.Color
      Target.Font.Bold = True
   Else
      Target.Style = "normal"
      End If
   End Sub
 

virdg

XLDnaute Nouveau
Re,
Seule la colonne B de la feuil2 est colorée dans le classeur joint .
Je joins 2 captures d’écran pour mieux expliciter mon souhait :

Feuille 1 j’ai une colonne A de couleur avec des chiffres de 1 à X , ces couleurs correspondent aux références de la colonne C,

Ex : ligne 6, ce jaune N°6 s’appelle P116-501D111

Et bien je voudrais que sur la feuille 2,

quand je rentre la valeur 6 dans la cellule C1, la couleur correspondante se mettent dans la cellule C2 avec le nom a laquelle elle fait référence : P116-501D111
 

Pièces jointes

  • 1.JPG
    1.JPG
    28.6 KB · Affichages: 24
  • 2.JPG
    2.JPG
    15.5 KB · Affichages: 23

fanch55

XLDnaute Barbatruc
Re, ce n'est pas ce que javais compris à la lecture du premier post.
Dans le classeur joint, j'ai supposé que vos colonnes Couleurs et Libellé font partie d'une table structurée .
 

Pièces jointes

  • virdg.xlsm
    18.5 KB · Affichages: 5

virdg

XLDnaute Nouveau
Re, ce n'est pas ce que javais compris à la lecture du premier post.
Dans le classeur joint, j'ai supposé que vos colonnes Couleurs et Libellé font partie d'une table structurée .
merci fanch, c'est exactement ce que je cherchais.
1-pourrais-je abuser en demandant que la valeur entrée ( le texte en fait) en C1 de la feuille 2 du fichier que tu m'as donné prenne la même couleur que le fond de la cellule afin de ne pas afficher le texte (les nombres en fait) et que la cellule paraisse vide de texte ?
merci beaucoup

2- a quoi sert le code de la feuille 1 ? celui-ci :

Sub col()
[A1].Interior.Color = vbMagenta
[A2].Interior.Color = vbCyan
[A3].Interior.Color = vbYellow
[A4].Interior.Color = vbGreen
[A5].Interior.Color = vbRed
End Sub
 

virdg

XLDnaute Nouveau
merci fanch, c'est exactement ce que je cherchais.
1-pourrais-je abuser en demandant que la valeur entrée ( le texte en fait) en C1 de la feuille 2 du fichier que tu m'as donné prenne la même couleur que le fond de la cellule afin de ne pas afficher le texte (les nombres en fait) et que la cellule paraisse vide de texte ?
merci beaucoup

2- a quoi sert le code de la feuille 1 ? celui-ci :

Sub col()
[A1].Interior.Color = vbMagenta
[A2].Interior.Color = vbCyan
[A3].Interior.Color = vbYellow
[A4].Interior.Color = vbGreen
[A5].Interior.Color = vbRed
End Sub
j'ai trouvé pour le texte : j'ai ajouter la ligne
Target.Font.Color = C.Interior.Color :)
 

fanch55

XLDnaute Barbatruc
merci fanch, c'est exactement ce que je cherchais.
1-pourrais-je abuser en demandant que la valeur entrée ( le texte en fait) en C1 de la feuille 2 du fichier que tu m'as donné prenne la même couleur que le fond de la cellule afin de ne pas afficher le texte (les nombres en fait) et que la cellule paraisse vide de texte ?
merci beaucoup

2- a quoi sert le code de la feuille 1 ? celui-ci :

Sub col()
[A1].Interior.Color = vbMagenta
[A2].Interior.Color = vbCyan
[A3].Interior.Color = vbYellow
[A4].Interior.Color = vbGreen
[A5].Interior.Color = vbRed
End Sub
C'est un résidu qui m'a servi à colorier le fond des cellules de A1 à A5 (flemme de passer par la souris).
Je vois que vous avez résolu votre 1er point.
 

virdg

XLDnaute Nouveau
bonjour a vous deux et aux autres peut être, une petite question ,
si je veux avoir la référence de couleurs non pas en dessous de C1 comme actuellement mais dans une autre cellule par ex : en D5, quel modif faut il faire dans le code VB ? sachant que je rentre toujours mon numéro de couleur en C1 , merci
 

fanch55

XLDnaute Barbatruc
Enrichi (BBcode):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range
Dim Lob As ListObject
Set Lob = Worksheets("Feuil1").ListObjects(1)
Application.EnableEvents = False
    If Target.Address = [C1].Address Then
        Set C = Lob.ListColumns("Couleurs").DataBodyRange.Find(Target, , xlValues, xlWhole)
        If Not C Is Nothing Then
            Target.Interior.Color = C.Interior.Color
            [D2].Value = Lob.ListColumns("Libellé").DataBodyRange.Rows(C.Row - Lob.DataBodyRange.Row + 1)
        Else
            Target.Interior.Color = xlNone
        End If
    End If
Application.EnableEvents = True
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh