Discussion :

[Lost_in_VBA]

Salut à tous!

Concrétement, je dispose de deux series: la premiere est un budget, la seconde le cout reel de mes actions.
Si le cout depasse le budget j'aimerais le voir en rouge, en orange lorsqu'il est à plus ou moins 10%, et en vert lorsqu'il est bien en dessous.

Du coup il faudrait le signaler sur la légende aussi que les 3 couleurs concernent la même série...
Ci joint un code que j'ai trouvé pour cela et que j'ai un peu retouché, mais les conditions sur la comparaison ne m'inspirent pas du tt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Chart_Reload()
ActiveChart.ChartTitle.Text = "Maintenance Cost"

Dim lngIndex As Long
On Error Resume Next
ActiveSheet.ChartObjects("Bilan des coûts").Activate
Application.ScreenUpdating = False
With ActiveChart.SeriesCollection(2)
For lngIndex = 1 To .Points.Count
a = Application.WorksheetFunction.Index(.Values, lngIndex)
With .Points(lngIndex)
If a < "90% de la valeur de la serie 1 pour le meme point" Then
.Interior.Color = RGB(60, 200, 80)
ElseIf a > "110% de la valeur de la serie 1 pr le meme point) Then
.Interior.Color = RGB(230, 180, 70)
Else
.Interior.Color = RGB(255, 255, 255)
End If
End With
Next
End With
Application.ScreenUpdating = True

End Sub

Une idée pr ajuster les couleurs et les conditions????
Sinn à quoi servent les deux lignes suivantes qu'on retrouve au début et à la fin???

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
On Error Resume Next
Application.ScreenUpdating = True

Merci d'avance

[mercatog]

A tester (lis les commentaires et adapte)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim A As Double, B As Double, C As Double
Dim i As Long, Klr As Long
Dim Ch As Chart
 
Application.ScreenUpdating = False
Set Ch = Worksheets("Feuil1").ChartObjects("Graphique 1").Chart 'Adapter nom de la feuille et nom du graphique
With Ch
    .HasTitle = True
    .ChartTitle.Text = "Maintenance Cost " & Date
    With .SeriesCollection(2)
        For i = 1 To .Points.Count
            A = Application.WorksheetFunction.Index(.Values, i)
            B = Application.WorksheetFunction.Index(Ch.SeriesCollection(1).Values, i)
            If B = 0 Then
                C = 1.1
            Else
                C = A / B
            End If
            Select Case C
                Case Is > 1: Klr = RGB(255, 0, 0)
                Case Is >= 0.9: Klr = RGB(230, 180, 70)
                Case Else: Klr = RGB(0, 255, 100)
            End Select
            .Points(i).Interior.Color = Klr 'Pas sûr, testé sur Excel 2010 .Points(i).Format.Line.ForeColor.RGB = Klr
        Next i
    End With
End With
Set Ch = Nothing

[Lost_in_VBA]

Merci d'avoir réagi encore une fois!!
J'ai justement adapté le code mais ça bug!
Je te joins un fichier pour que tu puisses voir ce que ça donne!
J'ai aussi corrigé les conditions J'ai l'impression qu'il y avait une petite erreur de saisie...

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Chart_Activate()
Dim A As Double, B As Double, C As Double
Dim i As Long, Klr As Long
 
Application.ScreenUpdating = False
With ActiveChart
    .HasTitle = True
    .ChartTitle.Text = "Maintenance Cost Monitoring " & Date
    With .SeriesCollection(2)
        For i = 1 To .Points.Count
            A = Application.WorksheetFunction.Index(.Values, i)
            B = Application.WorksheetFunction.Index(ActiveChart.SeriesCollection(1).Values, i)
            If B = 0 Then
                C = 1.1
            Else
                C = A / B
            End If
            Select Case C
                Case Is >= 1.1: Klr = RGB(255, 0, 0)
                Case Is >= 0.9: Klr = RGB(230, 180, 70)
                Case Else: Klr = RGB(0, 255, 100)
            End Select
            .Points(i).Interior.Color = Klr
        Next i
    End With
End With
End Sub

[Lost_in_VBA]

C'est Nickel!!!!
Merci beaucoup.