Discussion :

[taisherg]

Bonjour,

J'ai tout d'abord construit mon graphique de type histogramme à l'aide d'une requête. Il affiche, pour chaque produit de l'étude, le nombre de notes < à 3 et le nombre de notes > à 8. Jusque là c'est ok !

Je souhaiterais maintenant pouvoir afficher la moyenne des notes < à 3 pour l'ensemble des études (puis la moyenne des notes > à 8) sous forme d'une droite.

Une petite image pour illustrer le résultat souhaité :



Le problème est que la moyenne ne peut appartenir à ma requête me permettant de construire mon graph : donc pour un même graph, j'utilise 2 requête ! Est-ce possible ? Cela implique que j'ajoute une autre série de données à mon graph, certainement ?

Quelqu'un aurait-il une piste à me proposer pour avancer ???

Merci de votre aide.
Bonne journée.

[micniv]

Voici un travail qui m'avait demandé pas mal de recherches et de mises au point et qui me permet d'ajouter très souplement des series sur un graphe (celui ci-dessous était en nuage de points).

Je pense que tu sauras l'adapter à tes histogrammes et à ta demande.
Le côté génial est que je peux remplir "à la main" les cellules données de mon graphe.

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
 
 
Public Sub CompleteChart2000(o1Chart As Object, numIndent As Long, strTypIndent As String)
 
' But :
'   1 - Ajouter par VBA une 2eme serie, une 3 éme ...  au graphe
'   2 - Afficher une étiquette en fin de mesure sur courbe 2 et courbe 4
 
    If IsNothing(numIndent) Or IsNothing(strTypIndent) Then
        Debug.Print "pb appel CompleteChart2000:  noIndent ou TypIndent absents"
        Exit Sub
    End If
 
    Dim oOLE As Object
    Dim oDS
    Dim oChart As Chart
    Dim strSQL As String, strTxt As String
    Dim i As Long, J As Long
    Dim maBD As DAO.Database
    Dim rst As DAO.Recordset
    Dim intRowMax As Integer, intColMax As Integer, arrData As Variant
    Dim mySrs As Series, nbPts As Long
 
    Screen.MousePointer = 11    'hourglass cursor
 
    Set oOLE = o1Chart.Object               'Accesses the OLE object
    Set oDS = oOLE.Application.DataSheet    'Accesses the Datasheet of the OLE object
    Set oChart = oOLE.Application.Chart     'Accesses the Chart of the OLE object
 
    'Debug.Print "oOLE.SeriesCollection.Count: " & oOLE.SeriesCollection.Count
    strSQL = "SELECT cXtime, sngIndent, c2Y, c3Y ,sngTemp " _
           & " FROM rChartData " _
           & " WHERE [noIndent]= " & Nz(numIndent)
 
    Set maBD = CurrentDb
    Set rst = maBD.OpenRecordset(strSQL)
 
    If rst.RecordCount = 0 Then GoTo Fin
 
    arrData = rst.GetRows(400)    'MA limite MAX : 200 mesures par essai
 
    intRowMax = UBound(arrData, 1)  ' nb de courbes
    intColMax = UBound(arrData, 2)  ' nb de points / courbes
 
    Debug.Print "intRowMax: " & intRowMax
    Debug.Print "intColMax: " & intColMax
 
    'clear out any previous data
    oDS.Cells.Clear
 
    'Graph's Data Sheet cells are in row, column format,
    'starting at 1,1 with the row headers
    'GetRows data array is in column, row format starting at 0,0,
    'where row 0 is the first row of data; no field headers
 
    'Add the column heads from the recordset's fields to the data sheet
    'These are the data series names
    For i = 0 To rst.Fields.Count - 1
        oDS.Cells(1, i + 1) = rst.Fields(i).name
        Debug.Print "Cells 1, " & i + 1 & " arrData:" & rst.Fields(i).name
    Next i
    rst.Close
 
    '   Now add the data to each column
    For i = 0 To intRowMax          'courbe
        For J = 0 To intColMax      'points sur la courbe
            'Debug.Print "Cell(j:" & j + 2 & "i:" & i + 1 & ")   arrData:" & arrData(i, j)
            oDS.Cells(J + 2, i + 1) = IIf(arrData(i, J) > 0, arrData(i, J), 0.1)
            'Note these are reversed!
        Next J
    Next i
 
    'appliquer une étiquette à l'abcisse du point N de la série x.
 
 
    'nbPts = oChart.SeriesCollection(2).Points.Count
    'Utile pour effacer les affichages précédents
    For J = 2 To 2      'optimiser cette plage pour gagner du temps
        For i = 1 To oChart.SeriesCollection(J).Points.Count
            oChart.SeriesCollection(J).Points(i).ApplyDataLabels xlDataLabelsShowNone
            oChart.SeriesCollection(J).Points(i).HasDataLabel = False
        Next i
    Next J
 
    Select Case strTypIndent
    Case "A":
        strTxt = "6 min" & vbLf & "Essai A"
    Case "B":
        strTxt = "31 min" & vbLf & "Essai B"
    Case "C":
        strTxt = "31 min" & vbLf & "Essai C"
    End Select
 
    'Etiquette pour marquer l'abcisse de la fin du test
    '--------------------------------------------------
    ''Set mySrs = oChart.SeriesCollection(3)  'courbe des C3Y
    Set mySrs = oChart.SeriesCollection(2)    'courbe des C2Y
    i = mySrs.Points.Count - 1     'Avant-dernier point =intColMax
    With mySrs.Points(i)
        .ApplyDataLabels xlDataLabelsShowNone   'pour effacer les affichages précédents
        .ApplyDataLabels _
                Type:=xlDataLabelsShowValue, AutoText:=True, LegendKey:=False
        With .DataLabel.Font
            '.Superscript = True
            '.Interior.Color = RGB(255, 255, 255)
            .name = "Tahoma"
            .size = 10
        End With
        .DataLabel.Text = strTxt
    End With
 
 
 
Fin:
    Set mySrs = Nothing
    Set rst = Nothing
    Set maBD = Nothing
    Set oDS = Nothing
    Set oChart = Nothing
    Set oOLE = Nothing
 
Exit_Click:
    Screen.MousePointer = 0
    Exit Sub
 
Err_Click:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbCritical, "ERREUR " & Err.Number & " dans CompleteChart2000"
    Resume Exit_Click
 
End Sub