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

[Llewelys]

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

 

[Lolote83]

Bonjour,
Met le code suivant dans l'activation de la feuille2

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.

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]

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]

Salut,
Pas le temps cette après midi, il y a des potes à la maison.
Je crois cerner le problème.
Si d'autres réponses, tant mieux, sinon, j'essaye d'ici ce soir ou demain.
Bon dimanche
@+ Lolote83

 

[Llewelys]

Oui bien sûr, ce n'est pas pressé.
Merci beaucoup !

 

[Lolote83]

Re bonjour, ou même bonsoir,
Peut être avec ce code

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]

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 ?

 

[Lolote83]

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é

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

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.

@+ Lolote83

 

[Llewelys]

Tout est revenu à la normale, et j'arrive à faire exactement ce que je voulais.
Un grand merci

 

[patricktoulon]

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