Discussion :

[salivie]

j'aimerai savoir somment en peut réaliser des graphes("secteurs")
en code VBA
cordialement
salivie

[diude54]

Voici un code qui créé un graphe:
A adapter à ton cas

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
Set maplage = Range(Cells(lgraphe, 2), Cells(lgraphe + 6, ColDroite))
    EcartObj_a_fin = Int(Cells(lgraphe + 3, ColDroite).Value - Cells(lgraphe, 1).Value)
    PEcartObj_a_fin = Round(EcartObj_a_fin * 100 / Cells(lgraphe, 1).Value, 1)
    SMin = WorksheetFunction.Min(Range(Cells(lgraphe + 1, 3), Cells(lgraphe + 1, ColDroite)))
    SMax = WorksheetFunction.Max(Range(Cells(lgraphe + 1, 3), Cells(lgraphe + 1, ColDroite)))
    Objectif = Int(Cells(lgraphe, 1).Value)
    Prév_a_fin = Int(Cells(lgraphe + 3, ColDroite).Value)
 
    Set graphe = ThisWorkbook.Charts.Add
    ActiveSheet.Move After:=ThisWorkbook.Sheets(Sheets.Count)
    ActiveSheet.Name = Left(nom, 30)
    graphe.ChartArea.clear
    graphe.ChartType = xlXYScatterLines
    Set plageX = maplage.Rows(4)
    Set plageY1 = maplage.Rows(6)
    Set plageY2 = maplage.Rows(7)
    Set plagelabel = maplage.Rows(2)
 
    Set maserie1 = graphe.SeriesCollection.NewSeries
    With maserie1
        .Values = plageY1
        .XValues = plageX
        .Name = fsource.Cells(lgraphe + 5, 1).Value
        .MarkerBackgroundColorIndex = 25
        .MarkerForegroundColorIndex = 25
        .Border.ColorIndex = 25
    End With
    If Prév = True Then
    With maserie1.Points(ColDroite - 1)
    .MarkerBackgroundColorIndex = 44
    .MarkerForegroundColorIndex = 44
    .Border.ColorIndex = 44
    End With
    End If
 
    Set maserie2 = graphe.SeriesCollection.NewSeries
    With maserie2
        .Values = plageY2
        .XValues = plageX
        .Name = fsource.Cells(lgraphe + 6, 1).Value
        .MarkerBackgroundColorIndex = 50
        .MarkerForegroundColorIndex = 50
        .Border.ColorIndex = 50
        .MarkerStyle = xlMarkerStyleNone
    End With
 
    With graphe
    .HasTitle = True
    .Shapes.AddTextbox(msoTextOrientationHorizontal, 55, 45, 300, 50).Select
    Selection.AutoSize = True
    Selection.Characters.Text = "Ecart par raport à l'objectif: " & EcartObj_a_fin & "h" & Chr(10) & "Pourcentage d'écart par rapport à l'objectif: " & PEcartObj_a_fin & "%" & Chr(10) & "Semaine de Début: " & SMin & "  Dernière semaine: " & SMax & Chr(10) & "Prévisonel à fin: " & Prév_a_fin & "h" & Chr(10) & "Objectif: " & Objectif & "h"
    With Selection.Characters.Font
        .Name = "Times New Roman"
        .FontStyle = "Gras"
        .Size = 10
    End With
    With Selection
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 44
    Selection.ShapeRange.Fill.Transparency = 0#
    Selection.ShapeRange.Line.Weight = 1.5
    Selection.ShapeRange.Line.DashStyle = msoLineSolid
    Selection.ShapeRange.Line.Style = msoLineSingle
    Selection.ShapeRange.Line.Transparency = 0#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 12
    Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
    End With
 
    With .ChartTitle
      .Characters.Text = nom
      .Shadow = True
      .Border.Weight = xlHairline
   End With
 
    .HasLegend = True
    .Legend.Position = xlLegendPositionRight
       With .Axes(xlCategory, xlPrimary)
       .HasTitle = True
       .AxisTitle.Text = "Réalisé (h)"
       .TickLabels.Font.Bold = True
       End With
       With .Axes(xlValue, xlPrimary)
       .HasTitle = True
       .AxisTitle.Text = "%"
       .TickLabels.Font.Bold = True
       .HasMajorGridlines = True
        End With
    .HasDataTable = True
     End With