XL 2016 Couleur barre graphique dynamique

[CelluleVide]

Bonjour a tous,
Dans me fichier joint, une macro classe les données d'un graph dynamique.
J'ai besoin ensuite de "figer" les couleurs des barres en fonction du nom des étiquettes.
ex: PB 1 rouge; PB2; Orange...

 

[Rouge]

Bonjour
Voici,
Sub Couleur()
Application.ScreenUpdating = False
ReDim Coul_R(7) As Long
ReDim Coul_G(7) As Long
ReDim Coul_B(7) As Long
ReDim PB(7) As String
For i = 1 To 7
PB(i) = Cells(1, i + 11)
Coul_R(i) = (Cells(1, i + 11).Interior.Color) Mod 256
Coul_G(i) = ((Cells(1, i + 11).Interior.Color) Mod 65536) / 256
Coul_B(i) = (Cells(1, i + 11).Interior.Color) / 65536
Next i

ActiveSheet.ChartObjects("Graphique 1").Activate
For i = 1 To 7
ActiveChart.SeriesCollection(i).Interior.Color = RGB(Coul_R(i), Coul_G(i), Coul_B(i))
Next
End Sub
Cdlt

 

[CelluleVide]

Bonjour Rouge,
Merci de ta réponse, mais ta macro met les couleurs sur les barres dans l'ordre de celle-ci sur le graphique et de celui du tableau mais si une valeur est décochée cela se décale.
Je pense que c'est bien par rapport au nom de la série qu'il faut copier la couleur
De mon coté, j'ai avancé mais je bloque maintenant car le code fonctionne sur la première barre uniquement
Si les spécialistes VBA veulent bien jeter un œil sur le classeur je pense que je ne suis pas loin...

Merci d'avance

 

[Rouge]

Pardon, j'ai mal vu.
Voici la correction
Sub Couleur()
Application.ScreenUpdating = False
ReDim Coul_R(7) As Long
ReDim Coul_G(7) As Long
ReDim Coul_B(7) As Long
ReDim PB(7) As String
For i = 1 To 7
J = 1
PB(i) = Cells(1, i + 11)
Coul_R(i) = (Cells(1, i + 11).Interior.Color) Mod 256
Coul_G(i) = ((Cells(1, i + 11).Interior.Color) Mod 65536) / 256
Coul_B(i) = (Cells(1, i + 11).Interior.Color) / 65536
ActiveSheet.ChartObjects("Graphique 1").Activate
Do While UCase(ActiveChart.SeriesCollection(J).Name) <> " PB " & i
Cdlt
J = J + 1
If J > 7 Then Exit Sub
Loop
ActiveChart.SeriesCollection(J).Interior.Color = RGB(Coul_R(i), Coul_G(i), Coul_B(i))
Next i
End Sub

 

[CelluleVide]

Merci Rouge,
On est sur la bonne voie, peut-être vais-je te paraître pénible mais PB 1 PB2.... étaient là pour l'exemple en fait les libellés sont des textes différents (Ex: Panne toto; Arrêt machin, Pause, etc...)
Je vais essayer d'adapter ton code par tâtonnement mais si tu peux m'aider n'hésites pas.

 

[Rouge]

Bonjour,
Remplacez
Do While UCase(ActiveChart.SeriesCollection(J).Name) <> " PB " & i
par
Do While UCase(ActiveChart.SeriesCollection(J).Name) <> PB(i)
et remplacez toutes les valeurs 7 par le nombre de couleurs à tester.
Cdlt

 

[CelluleVide]

Bonjour Rouge,
J'ai remplacer la ligne mais ça bug.
Voir le fichier avec les nouveaux libellés.
Merci de ton aide.

 

[Rouge]

Bonjour,
Regardez bien les noms dans le TCD et ceux inscrits en ligne 1, dans le TCD, il y a un espace en début de chaque nom, il faut que vous rajoutiez un espace en début de chaque nom dans la ligne 1.

 

[CelluleVide]

Même avec l'ajout de l'espace cela ne marche pas.
En fait, je supprime "Somme de" au début de la macro mais je ne peux pas laisser le nom du champ seul car il me dit qu'il existe déjà d'où l'espace devant (Même résultat avec un autre caractère)
Idem en mettant " Do While UCase(ActiveChart.SeriesCollection(j).Name) <> " " & UCase(PB(i))
Pourrait-on afficher la valeur de UCase(ActiveChart.SeriesCollection(j).Name) afin de controler?
Msgbox() ne marche pas.

 

[Jauster]

Pour contrôler une valeur lorsque tu fais une macro
Clique droit sur ta variable (ex : Clique droit sur "ActiveChart.SeriesCollection(j).Name" puis Add Watch (Ajouter un espion). La variable apparaît ensuite en bas de ta fenêtre VBA. Tu pourras ensuite voir la valeur de ta variable lorsque tu exécutes la macro "step-by-step" avec F8.

Ici ton fichier ne marche pas à cause de
Do While UCase(ActiveChart.SeriesCollection(J).Name) <> PB(i)

Puisque PB(i) va prendre toutes les valeurs de ta ligne 1, alors que ton TCD (et donc ton graph) ne contient pas Cadence ou Defaut qu'il faut donc ajouter.

 

[Rouge]

Voilà,
'********** Changer les couleurs des barres **********
Set Plage = ActiveSheet.Range("MesCouleurs")
nb = Range("L1:S1").Cells.Count
ReDim Coul_R(nb) As Long
ReDim Coul_G(nb) As Long
ReDim Coul_B(nb) As Long
ReDim PB(nb) As String

For i = 1 To nb
j = 1
If Left(Cells(1, i + 11), 1) <> " " Then PB(i) = " " & Cells(1, i + 11) Else: PB(i) = Cells(1, i + 11)
Coul_R(i) = (Cells(1, i + 11).Interior.Color) Mod 256
Coul_G(i) = ((Cells(1, i + 11).Interior.Color) Mod 65536) / 256
Coul_B(i) = (Cells(1, i + 11).Interior.Color) / 65536
ActiveSheet.ChartObjects("Graphique 1").Activate
On Error Resume Next
Do While UCase(ActiveChart.SeriesCollection(j).Name) <> UCase(PB(i))
If Err.Number <> 0 Then
On Error GoTo 0
GoTo Suivant
End If
j = j + 1
If j > nb Then Exit Sub
Loop
ActiveChart.SeriesCollection(j).Interior.Color = RGB(Coul_R(i), Coul_G(i), Coul_B(i))
Suivant:
Next i

 

[CelluleVide]

Bonjour jauster,
C'était donc ça!
J'ai résolu (a priori!!!) le problème en insérant une ligne "On error resume next"

Merci a tous les deux (et a ceux qui ont essayé...)
Bonne journée