Macro Formatting Graphiques

Version imprimable

Bonjour à tous!

J'ai rédigé un petit code tout simple qui me permet d'harmoniser le format de mes graphiques sur Excel.

Le code se présente tel que suit :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Sub chart_format() Dim WSh As Worksheet Dim i, NbChart As Integer For Each WSh In ThisWorkbook.Worksheets WSh.Activate NbChart = ActiveSheet.ChartObjects.Count For i = 1 To NbChart With ActiveSheet.ChartObjects(i).Chart If .SeriesCollection.Count = 1 Then .SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(132, 199, 37) ElseIf .SeriesCollection.Count = 2 Then .SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(132, 199, 37) .SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(191, 191, 191) ElseIf .SeriesCollection.Count = 3 Then .SeriesCollection(1).Format.Fill.ForeColor.RGB = RGB(132, 199, 37) .SeriesCollection(2).Format.Fill.ForeColor.RGB = RGB(191, 191, 191) .SeriesCollection(3).Format.Fill.ForeColor.RGB = RGB(127, 127, 127) End If .Axes(xlValue).TickLabels.NumberFormat = "0" .ChartGroups(1).GapWidth = 70 .ChartGroups(1).Overlap = 0 .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 14 .ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Calibri(Body)" .ChartTitle.Format.TextFrame2.TextRange.Font.Bold = msoTrue .ChartArea.Border.LineStyle = xlNone .ChartArea.Format.Fill.Visible = msoFalse .PlotArea.Format.Fill.Visible = msoFalse .ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 71) End With Next i Next WSh End Sub
Mon souci se situe au niveau de la boucle If ... Then ... End If (en rouge ci-dessus).

Pour l'instant, je procède de la sorte : si mon graph n'a qu'une seule série, alors cette série est colorée en vert (132, 199, 37) ; s'il en a deux, alors la première est colorée en vert et la seconde en gris clair (191, 191, 191) ; et enfin s'il en a trois, alors la première est en vert, la deuxième en gris clair et la dernière en gris foncé (127, 127, 127).

Je pense que ce n'est probablement pas la meilleure facon de procéder, d'une part, mais mon vrai problème vient du fait que ce code ne répond pas à mon besoin. En effet, je cherche à colorer en vert la serie ayant le total le plus élevé et en gris foncé celle ayant le total le moins élevé. Savez-vous si cela est possible ? Et si c'est le cas, auriez-vous quelques pistes pour me mettre sur la voie ?

Merci beaucoup par avance !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub chart_format()
 
Dim WSh As Worksheet
Dim i As Integer
Dim SNum As Long
Dim Couleur(3) As Long
 
Couleur(1) = RGB(132, 199, 37)
Couleur(2) = RGB(191, 191, 191)
Couleur(3) = RGB(127, 127, 127)
 
For Each WSh In ThisWorkbook.Worksheets
    WSh.Activate
 
    For i = 1 To ActiveSheet.ChartObjects.Count
        With ActiveSheet.ChartObjects(i).Chart
 
            For SNum = 1 To .SeriesCollection.Count
                .SeriesCollection(SNum).Format.Fill.ForeColor.RGB = Couleur(SNum)
            Next SNum

Il aurait sans doute été plus élégant de se passer de SNum en faisant un For Each à la place d'un For To mais c'est sans doute plus clair ainsi.

31/07/2018, 15h41
clemanz

Merci beaucoup, c'est en effet bien mieux maintenant!

Cependant, et à moins d'avoir mal compris ce nouveau code, je ne pense pas qu'il réponde à mon besoin. Pour rappel, je cherche en effet à assigner la couleur verte (1) à la série dont le total est le plus élevé et la couleur gris foncé (3) à la série dont le total est le plus faible.

Est-ce possible selon vous ?

Merci!
31/07/2018, 16h22
Menhir

Tu utilises une variable d'indice 3 qui te permettra de conserver la somme de chaque série.

Tu fais une première boucle pour déterminer quelle somme est la plus grande.

Pour chaque Serie, avec la propriété Formula, tu récupères la plage de données.
Tu fais un Split en utilisant "," comme séparateur pour récupérer la plage des valeurs.
Tu évalues la somme avec un Evaluate et tu places le résultat dans l'indice correspondant de la variable créée au début.

Il ne te reste plus ensuite qu'à déterminer laquelle des 3 est la max et laquelle est la min pour lui affecter la bonne couleur.

Génial merci!

Voici mon code jusqu'à maintenant.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Option Explicit
Option Base 1
 
Sub chart_format()
 
 
Dim WSh As Worksheet
Dim i As Integer
Dim SNum As Long
Dim Couleur(3) As Long
Dim Series() As Double
Dim LArray() As String
Dim data_range As String
Dim b, Max, Min As Double
 
 
Couleur(1) = RGB(132, 199, 37)
Couleur(2) = RGB(191, 191, 191)
Couleur(3) = RGB(127, 127, 127)
 
For Each WSh In ThisWorkbook.Worksheets
 
WSh.Activate
 
 For i = 1 To ActiveSheet.ChartObjects.Count
        With ActiveSheet.ChartObjects(i).Chart
 
            For SNum = 1 To .SeriesCollection.Count
               data_range = .SeriesCollection(SNum).Formula
               LArray = Split(data_range, ",")
 
            ReDim Series(.SeriesCollection.Count)
               Series(SNum) = Evaluate("Sum(" & LArray(2) & ")")
            Next SNum
 
 
        .Axes(xlValue).TickLabels.NumberFormat = "0"
        .ChartGroups(1).GapWidth = 70
        .ChartGroups(1).Overlap = 0
        .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 14
        .ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Calibri(Body)"
        .ChartTitle.Format.TextFrame2.TextRange.Font.Bold = msoTrue
        .ChartArea.Border.LineStyle = xlNone
        .ChartArea.Format.Fill.Visible = msoFalse
        .PlotArea.Format.Fill.Visible = msoFalse
        .ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 71)
    End With
Next i
 
Next WSh
 
End Sub

Je bloque cependant sur la partie max/min. J'ai essayé d'appliquer la fonction Application.WorkSheetFunction.Max/Min à ma variable Series, mais cela me renvoie 0 en minimum pour un graphique à 2 series de total 10 et 14 respectivement.

Un conseil ?

Un immense merci pour cette aide précieuse!!!

31/07/2018, 21h16
Nagel Tha

L'un de mes projets de macro est justement une interface qui propose de modifier automatiquement les graphes et de voir le résultat sous la forme de la copie du graphe. Depuis j'ai eu l'occasion de découvrir les UserForms et cela pourrait en être une amélioration.

Si cela peut t'intéresser, je posterai (ici ou ailleurs) ma macro quand j'aurai terminé ^^
31/07/2018, 23h25
clemanz

Volontiers!
01/08/2018, 10h47
Nagel Tha

1 pièce(s) jointe(s)

Preview mise en forme automatique des graphes

Pièce jointe 400756

Voilà à quoi ça ressemble : tu renseignes toutes les mises en forme puis tu lances la macro. L'utilisation d'un UserForm permettra de le faire dynamiquement.

Cela te conviendrait ?

Pour finaliser le truc j'en ai pour un moment par contre et je ne vais pas pouvoir m'y remettre tout de suite :/
02/08/2018, 00h29
clemanz

Super !
Aucun probleme pour le delai !