Discussion :

[gaston64]

à partir d'une macro VBA, je souhaite supprimer le cadre du graphique et colorier le fond de la série nommée "etalon". J'ai essayé avec l'enregistreur de macro mais je ne suis pas parvenu à adapter la syntaxe

ci-joint mon fichier

Comment faire? Merci

[mercatog]

Sur ton fichier

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
Sub FormaterGraph()
Dim Pt As Point
Dim i As Integer
Dim Tb
 
With Worksheets("test").ChartObjects("Graphique 9").Chart
    .ChartArea.Format.Line.Transparency = 1
    Tb = .SeriesCollection(1).XValues
    For Each Pt In .SeriesCollection(1).Points
        i = i + 1
        If Tb(i) = "etalon" Then
            Pt.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Exit For
        End If
    Next Pt
End With
End Sub

[gaston64]

Merci cela fonctionne!

[gaston64]

rebonjour mercatog

lorsque la série étalon se trouve en première position la macro ne permet pas de colorier le fond de la série.

j'ai essayé avec

Code :

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

1
2
3
4
        If Tb(1) = "Budget" Then
            Pt.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Exit For
        End If

... mais sans succès. Aurais-tu une solution?

[mercatog]

Tb(1)?

Mets ici ton code en entier

[gaston64]

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub histogramme()
 
Dim dimension1 As Integer
 
m = 10
debut1:
m = m + 1
If Cells(m, 1) <> "Prix classement" Then
GoTo debut1
End If
debutvertical = m
 
n = 9
debut2:
n = n + 5
If Cells(debutvertical, n) <> "" Then
GoTo debut2
End If
finhorizontale = n - 5
 
dimension1 = (finhorizontale - 14) / 5 + 1
 
ActiveSheet.ChartObjects.Delete
 
ReDim tabD(dimension1) As String
ReDim tabCumul(dimension1) As Variant
Dim i As Integer
 
x = -1
For i = 14 To finhorizontale Step (5)
 
    If cestbon = False And Cells(debutvertical - 9, 4).Value < Cells(debutvertical, i).Value Then
    x = x + 1
    tabD(x) = "Budget"
    tabCumul(x) = Cells(debutvertical - 9, 4).Value
    cestbon = True
    jj = (i - 14) / 5 + 1
    End If
 
x = x + 1
tabD(x) = Cells(2, i).Value
tabCumul(x) = Cells(debutvertical, i).Value
Next i
 
    If cestbon = False Then
    x = x + 1
    tabD(x) = "Budget"
    tabCumul(x) = Cells(debutvertical - 9, 4).Value
    cestbon = True
    jj = (i - 14) / 5 + 1
    End If
 
Set cht = ActiveSheet.ChartObjects.Add(100, 50, 1000, 400)
With cht.Chart
    Set ser = .SeriesCollection.NewSeries
    With ser
        .XValues = tabD
        .Values = tabCumul
        .Border.ColorIndex = 5
    End With
 
ActiveSheet.ChartObjects.Left = Range("A50").Left + 5
ActiveSheet.ChartObjects.Top = Range("A50").Top + 5
ActiveSheet.ChartObjects.Width = 550
ActiveSheet.ChartObjects.Height = 310
 
.SeriesCollection(1).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorText1
.SeriesCollection(1).Format.Fill.ForeColor.Brightness = 0.349999994
.ChartArea.Format.Line.Visible = False
    Tb = .SeriesCollection(1).XValues
    For Each Pt In .SeriesCollection(1).Points
 
        'If Tb(1) = "Budget" Then
        '    Pt.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
        '    Exit For
        'End If
 
        g = g + 1
        If Tb(g) = "Budget" Then
            Pt.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
            Exit For
        End If
    Next Pt
 
    .Legend.Delete
    .SeriesCollection(1).Format.Line.Visible = msoFalse
    .Axes(xlCategory).TickLabels.Orientation = 30
 
End With
 
End Sub