Création d'un graphe avec macro

Version imprimable

Bonjour à tous,

j'ai réussi à bidouiller du code pour qu'une macro me crée un graphe de type diagramme en batons avec trois plages de données. Le problème c'est que la macro ne fonctionne pas de facon très stable. Si je la relance plusieurs fois sur les mêmes données je peux avoir soit le bon graphe, soit un graphe avec 4 (voire plus) plages de données, soit un bug au niveau de la ligne ".SeriesCollection(1).XValues = Tabelle13.Range("AB4:AP4")"

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
 
Tabelle13.Shapes.AddChart(xlColumnClustered, Top:=100, Left:=3000, Width:=600, Height:=300).Select
With ActiveChart
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue).MaximumScale = 250
        .Axes(xlValue).MajorUnit = 50
        .Axes(xlValue).MinorUnit = 10
        .ChartGroups(1).GapWidth = 0
        .ChartGroups(1).Overlap = 100
        .HasTitle = True
        .ChartTitle.Characters.Text = "CTB10: 0.08s/mm, Defocus: 0mm"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
        .SeriesCollection(1).XValues = Tabelle13.Range("AB4:AP4")
        .SeriesCollection(1).Values = Tabelle13.Range("AB5:AP5")
        .SeriesCollection(1).Name = "50%"
        .SeriesCollection(1).ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:=Range("AB17:AP17"), MinusValues:=Range("AB29:AP29")
        .SeriesCollection(2).Values = Tabelle13.Range("AB6:AP6")
        .SeriesCollection(2).Name = "85%"
        .SeriesCollection(2).ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:=Range("AB18:AP18"), MinusValues:=Range("AB30:AP30")
        .SeriesCollection(3).Values = Tabelle13.Range("AB7:AP7")
        .SeriesCollection(3).Name = "95%"
        .SeriesCollection(3).ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:=Range("AB19:AP19"), MinusValues:=Range("AB31:AP31")
End With

Et je vous met ce a quoi ressemble une partie de mon tableau, avec la première case étant AA4 :

		17			42.5			85			170
50%	220			155			103			70
85%		223			152			103			67
95%			220			145			96			67

Merci de votre aide si vous avez une petite idée sur ce problème

25/04/2014, 11h14
AbsolutAlex

Hello,

Pour mieux comprendre tes attentes, peux tu fournir un screenshot du graph que tu attends ?
Je pense que le problème vient des cases vides que tu as dans ton tableau.

Alex

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
Dim Ch As Chart
Dim k As Integer
 
Set Ch = Tabelle13.ChartObjects.Add(100, 300, 600, 300).Chart
With Ch
    .ChartType = xlColumnClustered
    .Axes(xlValue).MinimumScale = 0
    .Axes(xlValue).MaximumScale = 250
    .Axes(xlValue).MajorUnit = 50
    .Axes(xlValue).MinorUnit = 10
    .ChartGroups(1).GapWidth = 0
    .ChartGroups(1).Overlap = 100
    .HasTitle = True
    .ChartTitle.Characters.Text = "CTB10: 0.08s/mm, Defocus: 0mm"
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False
    For k = 5 To 7
        With .SeriesCollection.NewSeries
            .XValues = Tabelle13.Range("AB4:AP4")
            .Values = Tabelle13.Range("AB" & k & ":AP" & k)
            .Name = Format(Tabelle13.Range("AA" & k), "0%")
            .ErrorBar Direction:=xlY, Include:=xlErrorBarIncludeBoth, Type:=xlErrorBarTypeCustom, Amount:=Tabelle13.Range("AB" & 12 + k & ":AP" & 12 + k), MinusValues:=Tabelle13.Range("AB" & 24 + k & ":AP" & 24 + k)
        End With
    Next k
End With
Set Ch = Nothing

25/04/2014, 12h18
Invité

bonjour,

Regardes ce lien:
http://www.developpez.net/forums/d14...e/#post7650128
25/04/2014, 13h18
rouxmasta

Merci Mercatog, le fait de definir un chart a du etre bien utile. Je pense que ca va marcher sans problèmes. Du coup il ne me reste plus qu'à modifier le tout pour automatiser la création de tous les graphes.