XL 2016 Copier la couleur d'une cellule sur une autre feuille

[christ77000]

Bonsoir,
est il possible de prendre la couleur de la cellule A1 de ma feuille xxx et de reporter cette même couleur dans ma feuille Menu en A31.


exemple:

A1 est utiliser par les équipes pour mettre leur couleur.

Feuille menu :
en A31 couleur équipe 1 - en D31 nom la feuille - En E31 contrôle si la feuille existe (OK/NOK)
en A32 couleur équipe 2 - en D32 nom la feuille - En E32 contrôle si la feuille existe (OK/NOK)
en A33 couleur équipe 3 - en D33 nom la feuille - En E33 contrôle si la feuille existe (OK/NOK)
en A34 couleur équipe 4 - en D34 nom la feuille - En E34 contrôle si la feuille existe (OK/NOK)
en A35 couleur équipe 5 - en D35 nom la feuille - En E35 contrôle si la feuille existe (OK/NOK)

donc il faudrait qu'en A31 soit repris la couleur de la feuille dont le nom est en D31 cellule A1 uniquement si en E31 c'est marqué OK

en espérant être claire dans mon explication. Merci pour votre aide.

 

[_Thierry]

Bonsoir @christ77000 , le Forum

Ce serait mieux avec un fichier exemple, ça m'aurait évité d'en fabriquer un ! 😉

Voici ce que j'ai compris...

Bien à toi, à vous
@+Thierry

PS EntreTemps tu a édité ton post !! Arf

 

[_Thierry]

Re Christ !

Voici la version adaptée à ta dernière édition du post #1

@+Thierry

 

[christ77000]

Désolé pour l'édition de mon message je ne pensais pas a une réponse si rapide. Mais il me semblait important de préciser si la feuille existe ou non

 

[_Thierry]

Re Christ

Mon approche est différente dans la v01 en fait je liste toutes les feuilles existantes dans la colonne "D" si elles ne se nomment pas "Menu" , et dans la colonne "B" je signale si c'est vide "A renseigner !" (En fait je me fiche de savoir ce qui est saisi en "B" je ne controle pas avec le nom des feuilles)

La colonne "E" quant à elle, me sert à indiquer NOK si aucune couleur en "A1", pas du tout si la feuille n'existe pas, ce qui n'est pas possible puisque je ne liste QUE des feuilles existantes...

Je ne sais pas si c'est ton souhait...
@+Thierry

 

[christ77000]

alors ton code fonctionne a merveille c'est exactement ce que je recherche mais je n'arrive pas a l'adapter a mes feuilles. Je te joint un extrait de mon fichier. Car j'ai déjà un contrôle de l'existence des feuilles.

 

[christ77000]

En faite je récupère la liste des onglets et sur chaque feuille des équipes il y a dans une cellule le nom de l'onglet je fis une comparaison et ok ou nok

 

[christ77000]

dans le fichier je devrais avoir en a33 la couleur de la cellule a1 de la feuille GC-2020 puisqu'elle existe

 

[christ77000]

j'ai tenter un code qui contrôle si la feuille existe mais je n'arrive pas a faire la suite

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
On Error Resume Next
FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function


Sub colorier_equipe()
  If FeuilleExiste(ThisWorkbook, Range("D33").Value) Then
   Sheets("Menu").Range("A31").Interior.ColorIndex = FeuilleExiste.Range("A1").Interior.ColorIndex
   Else
   
  End If
End Sub

 

[_Thierry]

Re Bonsoir

Moi j'ai travaill directement sur ton fichier, j'ai mis les Triggers événementiels en comments, mais donc j'ai un résultat comme dans le fichier joint...

Ce n'est pas du tout la même approche que dans ton post #9

A toi de voir ...

@+Thierry

 

[christ77000]

L'approche est différente mais cela ne me gène pas. Il y a juste un problèmes, si je supprime des feuilles les couleurs ne se retire pas .

 

[christ77000]

moi j'ai testé avec ce code le seul problème est de devoir nommer les feuilles
Sheets("GD-2020") alors que le nom est en D33 car si le nom de la feuille change ma macro est hs et pire je dois répéter ce code pour les 5 équipes. Ce code est dans bouton menu des feuilles des equipes

Function FeuilleExiste(wk As Workbook, stFeuille) As Boolean
 On Error Resume Next
 FeuilleExiste = Not (wk.Sheets(stFeuille) Is Nothing)
End Function

Sub colorier_equipes()
If FeuilleExiste(ThisWorkbook, Range("D31").Value) Then
      Sheets("Menu").Range("A31").Interior.ColorIndex = Sheets("GD-2020").Range("A1").Interior.ColorIndex
   Else
  
  End If
End Sub

 

[_Thierry]

Re Re Re ! 😉

Pour ta question du post #11 tu peux dans le Trigger Workbook_SheetBeforeDelete ajouter une une commande style :
WsMenu.Range("A31:A35")..Interior.ColorIndex = xlNone et relancer le Team_Color

Ou encore mettre cette intruction en début de cette procédure Team_Color (près de PlageNOKOK.ClearContents)

Pour le Post #12, je t'avouerai que je n'ai pas essayé.

Bonne nuit
@+Thierry

 

[_Thierry]

Ou au lieu d'xlNone de remettre le rouge de ta feuille dont l'index est 3

Sub ActiveCellColorIndex()
MsgBox ActiveCell.Interior.ColorIndex
End Sub

@+Thierry

 

[job75]

Bonjour christ77000, _Thierry,

Voyez cette macro dans le code de la feuille "Menu" :

Private Sub Worksheet_Activate()
Dim c As Range, w As Worksheet, coul&
On Error Resume Next 'si une feuille n'existe pas
For Each c In [D31:D35] 'à adapter
    Set w = Nothing: Set w = Sheets(CStr(c))
    c(1, 2) = IIf(w Is Nothing, "NOK", "OK")
    If w Is Nothing Then coul = 255 Else coul = w.Cells(1).Interior.Color
    c(1, -2).Interior.Color = coul
Next
End Sub

Elle se déclenche quand on active la feuille.

A+