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

christ77000

XLDnaute Occasionnel
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.
 
Dernière édition:
Solution
Bonjour @christ77000 @job75 , le Forum

Quand on parle de ColorIndex :
Sans couleur ou redevenir rouge ? Dans mes post précédents tu as les explications
xlNone = Sans Couleur
3 = Le rouge de ta feuille Menu

Quand on parle de Color :
Pour le code RGB 255 c'est bien Rouge

@+Thierry

Edit: et pour la Propriéte Color pour "Sans Couleur" le xlNone est applicable aussi

_Thierry

XLDnaute Barbatruc
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
 

Pièces jointes

  • XLD_Christ77000_IndexColor_Teams_v00.xlsm
    20.9 KB · Affichages: 1

_Thierry

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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.
 

Pièces jointes

  • IT6-2020.xlsm
    173.1 KB · Affichages: 5

christ77000

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

VB:
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • XLD_Christ77000_IndexColor_Teams_v02.xlsm
    152.6 KB · Affichages: 5

christ77000

XLDnaute Occasionnel
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

VB:
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

XLDnaute Barbatruc
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
 

job75

XLDnaute Barbatruc
Bonjour christ77000, _Thierry,

Voyez cette macro dans le code de la feuille "Menu" :
VB:
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+
 

Pièces jointes

  • IT6-2020(1).xlsm
    181 KB · Affichages: 3

Discussions similaires

Réponses
0
Affichages
306
Haut Bas