XL 2019 Copie d'une couleur d'une cellule à une autre

Llewelys

XLDnaute Nouveau
Bonjour à tous,

J'aimerais copier le format (plus précisément la couleur) d'une cellule à une autre, et cela sur plusieurs feuilles.

Par exemple
Si feuille1!A1 est rouge il faudrait que feuille2!B1:B3 soit rouge
Et si feuille1!A1 est changé en vert, il faudrait que feuille2!B1:B3 soit automatiquement changé en vert.

Il faudrait que la solution fonctionne dans des cellules vides, ou en tout cas que ce soit indépendant de leur contenu.

Cette question a été postée ici : https://www.excel-downloads.com/threads/copie-du-format-dune-cellule.84208/
Mais aucune réponse n'a été apportée.

En vous remerciant,
Llewelys
 
Solution
Bonjour,
Met le code suivant dans l'activation de la feuille2
VB:
Private Sub Worksheet_Activate()
    xCoul = Sheets("Feuil1").Range("A1").Interior.ColorIndex
    Sheets("Feuil2").Range("B1:B3").Interior.ColorIndex = xCoul
End Sub

Voir également la copie d'écran.

1644144135788.png


Une fois la couleur changée en feuille1, lorsque tu sélectionnes la feuille2, les données "B1:B3" prendront la couleur de A1 de la feuille1
@+ Lolote83

Lolote83

XLDnaute Barbatruc
Bonjour,
Met le code suivant dans l'activation de la feuille2
VB:
Private Sub Worksheet_Activate()
    xCoul = Sheets("Feuil1").Range("A1").Interior.ColorIndex
    Sheets("Feuil2").Range("B1:B3").Interior.ColorIndex = xCoul
End Sub

Voir également la copie d'écran.

1644144135788.png


Une fois la couleur changée en feuille1, lorsque tu sélectionnes la feuille2, les données "B1:B3" prendront la couleur de A1 de la feuille1
@+ Lolote83
 

Llewelys

XLDnaute Nouveau
Ca fonctionne, merci !

A un détail près que je ne m'explique pas :
Lorsque la couleur de A1 est jaune, rouge ou orange, les cellules B1:B3 sont bien jaunes, rouges ou orange.
Par contre lorsque A1 est bleue, verte ou grise, les cellules B1:B3 sont d'un vert, d'un bleu ou d'un gris différents (même en cliquant sur une autre cellule ; ce n'est pas un problème de cellules sélectionnées)
 

Lolote83

XLDnaute Barbatruc
Re bonjour, ou même bonsoir,
Peut être avec ce code
VB:
Private Sub Worksheet_Activate()
    xCoul = Sheets("Feuil1").Range("A1").Interior.Color
    xR = Int(xCoul Mod 256)
    xV = Int((xCoul Mod 65536) / 256)
    xB = Int(xCoul / 65536)
    Sheets("Feuil2").Range("D1:D3").Interior.Color = RGB(xR, xV, xB)
End Sub
@+ Lolote83
 

Llewelys

XLDnaute Nouveau
Ok c'est parfait merciiii

J'avoue ne pas comprendre l'erreur du premier script : il ne fait que copier une couleur et donner cette couleur à une autre cellule.
Je ne connais pas Excel au-delà de son usage de base (j'ai découvert aujourd'hui les VBA) ; il y a des modifications d'une feuille à l'autre ?

Edit : J'ai changé quelque chose (la couleur de A1 n'est plus manuelle mais soumise à une condition), et le code ne fonctionne plus : les cellules B1:B3 sont blanches (le remplissage est blanc, pas "sans remplissage") alors que A1 ne l'est pas.
Une idée de pourquoi et de comment faire en sorte que ça re-marche ?
 
Dernière édition:

Lolote83

XLDnaute Barbatruc
Re bonjour,
Désolé pour la réponse tardive.
Quand vous dites :
J'ai changé quelque chose (la couleur de A1 n'est plus manuelle mais soumise à une condition),
cela doit il être interprété que vous avez fait une MFC (Mise en Forme Conditionnelle). Si c'est le cas, il faudra modifier le code car c'est totalement différent.

La partie déjà traitée = code ci-dessous légèrement modifié
VB:
Private Sub Worksheet_Activate()
    'xCoul = Sheets("Feuil1").Range("A1").Interior.Color
    xCoul = COULEUR(Sheets("Feuil1").Range("A1"))
    xR = Int(xCoul Mod 256)
    xV = Int((xCoul Mod 65536) / 256)
    xB = Int(xCoul / 65536)
    Sheets("Feuil2").Range("D1:D3").Interior.Color = RGB(xR, xV, xB)
End Sub

puis il faudra rajouté un module avec ce code
Code:
Function COULEUR(Cellule As Range)
    '----------------------------------------------------------------------
    'Fonction COULEUR : Sébastien Mathier - Excel-Pratique.com
    'Source : https://www.excel-pratique.com/fr/astuces_vba/fonction-couleur-mfc
    '----------------------------------------------------------------------
    Application.Volatile
    COULEUR = Evaluate("CouleurCellule('" & Cellule.Worksheet.Name & "'!" & Cellule.Address & ")")
End Function

Private Function CouleurCellule(Cellule As Range)
    CouleurCellule = Cellule.DisplayFormat.Interior.Color
End Function

comme le montre la copie d'écran ci-dessous.
1644245071857.png


@+ Lolote83
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir
une question
pourquoi passer par RGB?
.Interior.Color devrait suffire
avec interior.color.index effectivement si la couleur ne fait pas partie des 56 couleur de la palette actuelle du thisworkbook.colors il se peut effectivement qu'il y est des divergences d'une feuille à l'autre

si tu a des soucis avec ta palette que les index ne te donnent plus les bonnes couleurs
faire un ActiveWorkbook.ResetColors
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 756
Membres
101 812
dernier inscrit
trufu