XL 2016 Couleur barre graphique dynamique

R

Rouge

XLDnaute Impliqué

• 4 Janvier 2018

• #2

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

 

Vote positif 0 Vote négatif

CelluleVide

XLDnaute Occasionnel

• 4 Janvier 2018

• #3

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

 

Pièces jointes

• Couleurs Graph V2.xlsm

  54.9 KB · Affichages: 26

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 4 Janvier 2018

• #4

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

 

Vote positif 0 Vote négatif

CelluleVide

XLDnaute Occasionnel

• 4 Janvier 2018

• #5

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.

 

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 5 Janvier 2018

• #6

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

 

Vote positif 0 Vote négatif

CelluleVide

XLDnaute Occasionnel

• 5 Janvier 2018

• #7

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

 

Pièces jointes

• Couleurs Graph V3.xlsm

  55.8 KB · Affichages: 21

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 5 Janvier 2018

• #8

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.

 

Vote positif 0 Vote négatif

CelluleVide

XLDnaute Occasionnel

• 5 Janvier 2018

• #9

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.

 

Vote positif 0 Vote négatif

Jauster

XLDnaute Occasionnel

• 5 Janvier 2018

• #10

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.

 

Pièces jointes

• Couleurs Graph V3.xlsm

  56.2 KB · Affichages: 18

Vote positif 0 Vote négatif

R

Rouge

XLDnaute Impliqué

• 5 Janvier 2018

• #11

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

 

Vote positif 0 Vote négatif

CelluleVide

XLDnaute Occasionnel

• 5 Janvier 2018

• #12

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

 

Vote positif 0 Vote négatif