Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
J'édite un graphique (camembert ou histogramme avec plusieurs séries) que je remets à jour régulieremenr. je voudrais utiliser toujours la même couleur pour la même série "en automatique". (Le nombre de série peut varier, ce qui m'oblige à modifier une à une les couleurs du graphique ...). Je joins un fichier d'exemple pour plus de facilité.
Seb!
Merci beaucoup pour la réponse ! (et la rapidité )
La solution est bien, mais il reste 2 points :
-Si la série "A" se trouve en ligne 8 la couleur de la série est jaune, moi je voudrais que la série "A" reste en rouge sur le graphe (comme au départ)
- ensuite si je supprime la ligne la serie "F" (suppression de la ligne) les couleurs sont décalées : la série "G" est en noir alors qu'elle devrait être en marron ci-joint le fichier :
Seb !
re
Je ne pense pas que ce soit possible ce que tu demande.
Les couleurs sont affectés en fonction de la premiere série, la macro ne peut pas testé les valeurs de cellule et mettre une couleur en fonction de cela. ( mais je ne suis pas un expert en macro)
Pas certain d'avoir vraiment cerné la totalité du problème, mais vous trouverez en pièce jointe ce que j'ai compris de votre échange...
Le code utilisé est le suivant :
Code:
[SIZE=2][COLOR=GRAY][B][I]DANS LE MODULE DE CODE DE LA FEUILLE[/I][/B][/COLOR]
[COLOR=NAVY]Private Sub[/COLOR] Worksheet_Change([COLOR=NAVY]ByVal[/COLOR] Target [COLOR=NAVY]As[/COLOR] Range)
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Cel [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]If[/COLOR] Target.Count > 1 [COLOR=NAVY]Then Exit Sub
If Not[/COLOR] Application.Intersect(Target, Range("B6:B30")) [COLOR=NAVY]Is Nothing Then
Set[/COLOR] Cel = Sheets("Corresp.Couleurs").Columns(1).Find(Target.Value, LookIn:=xlValues)
[COLOR=NAVY]If Not[/COLOR] Cel [COLOR=NAVY]Is Nothing Then[/COLOR]
Target.Offset(0, -1).Interior.Color = Cel.Interior.Color
ActiveSheet.ChartObjects("Graphique 1").Chart.SeriesCollection(1) _
.Points(Target.Row - 5).Interior.Color = Cel.Interior.Color
[COLOR=NAVY]End If
End If
End Sub[/COLOR][/SIZE]
L'utilisation est expliquée dans le classeur joint.
Bravo MDF ! c'est super ce que tu as fait !
(juste une petite remarque, lorsque on change la couleur dans corresp couleurs, il faut "retaper" le nom de la serie pour qu'excel fasse la modif)
En tout cas ton fichier me va très bien
Merci beaucoup !
Seb!
C'est encore moi, je voudrais faire la même chose avec un histogramme, je pensais y arriver, mais je ne connais pas suffisament VBA. Je joins le fichier pour exemple. (En faite je voudrais à la fois un camembert et un histogramme sur la même feuille)
Merci d'avance
Seb!
Cher ami Bruno, pour ma part, c'est grâce à ton travail que je me familiarise peu à peu avec les graphiques Excel. Sur ce thème, il me reste, moi aussi, beaucoup à apprendre et je t'en remercie.
Seb2, tu trouveras ci-joint ton fichier modifié selon tes souhaits.
J'ai dû modifier légèrement la procédure pour trouver un traitement commun aux 2 types de graphique :
Code:
[SIZE=2][COLOR=GRAY][B][I]DANS LE MODULE DE CODE DE LA FEUILLE[/I][/B][/COLOR]
[COLOR=NAVY]Private Sub[/COLOR] Worksheet_Change([COLOR=NAVY]ByVal[/COLOR] Target [COLOR=NAVY]As[/COLOR] Range)
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Graph [COLOR=NAVY]As[/COLOR] ChartObject
[COLOR=NAVY]Dim[/COLOR] Cel [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]If[/COLOR] Target.Count > 1 [COLOR=NAVY]Then Exit Sub
If Not[/COLOR] Application.Intersect(Target, Range("B6:B30")) [COLOR=NAVY]Is Nothing Then
Set[/COLOR] Cel = Sheets("Corresp.Couleurs").Columns(1).Find(Target.Value, LookIn:=xlValues)
[COLOR=NAVY]If Not[/COLOR] Cel [COLOR=NAVY]Is Nothing Then[/COLOR]
Target.Offset(0, -1).Interior.Color = Cel.Interior.Color
[COLOR=NAVY]For Each[/COLOR] Graph [COLOR=NAVY]In[/COLOR] ActiveSheet.ChartObjects
Graph.Chart.Legend.LegendEntries(Target.Row - 5).LegendKey.Interior.Color = Cel.Interior.Color
[COLOR=NAVY]Next[/COLOR] Graph
[COLOR=NAVY]End If
End If
End Sub[/COLOR][/SIZE]
J'agis cette fois directement sur les légendes du graphique et non plus sur les séries, ce qui donne au final le même effet pour tous les graphiques présents.
Par ailleurs, ta remarque est bonne, seule la modification du nom de série en feuille principale peut faire agir cette macro. Ainsi, en cas de modification des couleurs en feuille "Corresp.Couleurs", il faut obligatoirement revalider le nom de série correspondant en feuille principale pour déclencher le traitement.
... C’est encore moi ...
Il y a un petit bug dans la macro que je n’arrive pas à résoudre, à partir de la lettre G (cellule B12) lorsque je retape cette lettre pour mettre à jour la couleur j’ai le message d’erreur suivant : Impossible de lire la propriété Legendentries de la classe legend. ...
Je ne comprends pas pourquoi le problème apparait seulement à partir de G.
Seb !
Ton graph "histogramme" ne possède pas de série (et donc de légende) au-delà de F... d'où l'erreur !
Peut-être faudrait-il que tu revois de façon logique tes graphiques.
Sinon, si tu veux contourner ce message causé, il est vrai, par un seul des deux graphiques :
Code:
[SIZE=2][COLOR=GRAY][B][I]DANS LE MODULE DE CODE DE LA FEUILLE[/I][/B][/COLOR]
[COLOR=NAVY]Private Sub[/COLOR] Worksheet_Change([COLOR=NAVY]ByVal[/COLOR] Target [COLOR=NAVY]As[/COLOR] Range)
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Graph [COLOR=NAVY]As[/COLOR] ChartObject
[COLOR=NAVY]Dim[/COLOR] Cel [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]If[/COLOR] Target.Count > 1 [COLOR=NAVY]Then Exit Sub
If Not[/COLOR] Application.Intersect(Target, Range("B6:B30")) [COLOR=NAVY]Is Nothing Then
Set[/COLOR] Cel = Sheets("Corresp.Couleurs").Columns(1).Find(Target.Value, LookIn:=xlValues)
[COLOR=NAVY]If Not[/COLOR] Cel [COLOR=NAVY]Is Nothing Then[/COLOR]
Target.Offset(0, -1).Interior.Color = Cel.Interior.Color
[COLOR=NAVY][B]On Error Resume Next
[/B] For Each[/COLOR] Graph [COLOR=NAVY]In[/COLOR] ActiveSheet.ChartObjects
Graph.Chart.Legend.LegendEntries(Target.Row - 5).LegendKey.Interior.Color = Cel.Interior.Color
[COLOR=NAVY]Next[/COLOR] Graph
[COLOR=NAVY][B]On Error GoTo[/B][/COLOR] 0
[COLOR=NAVY]End If
End If
End Sub[/COLOR][/SIZE]
Encore merci ! T'est vraiment sympa.
J'ai fais les modif dans le fichier et tout marche bien.
Je joins ici la dernière version du fichier avec un camembert et un histogramme. Ce fichier permet de définir les couleurs de la légende des deux graphes et aussi de les modifier. Les deux graphes comportent 26 series (ce qui est beaucoup trop) mais on peut toujours en supprimer.
J'ai voulu améliorer le fichier pour obtenir un graphique dynamique avec la commande DECALER. Mais j'ai des problème avec l'histogramme.
Depuis la modification, l'affichage des valeurs et de la légende est faux pour l'histogramme, il y a une permutation circulaire de la légende (et des valeurs) à chaque mise à jour. Et je n'arrive pas à regler le problème.
Ci-joint le fichier :
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.