Graphique empilé 100%

**JMPS.VBA** · 17/05/2010, 21h22

Bonjour à tous,

Ci-joint un modèle pour la réalisation d'un graphique empilé 100% sous Access 2007. Ce modèle intégre trois séries de données, pour 100 données affichables. C'est loin, très loin, d'être parfait et universel. Il faudra l'adapter à vos besoins.

L'idée c'est d'avoir
- une tables avec des données dont un champs qui servira pour l'abscisse, et des champs qui serviront pour l'ordonnée.
- un état de cette table, avec un niveau de regroupement sur le champs de l'abscisse, tous les champs dont on a besoin, et pour pas trop se fatiguer, un champs "cumul" pour avoir un total et calculer après le 100%.
- beaucoup de code.

Si dieux le père d'Access veut bien perfectionner tout ça pour l'universaliser pour le commun des mortels dont je suis, bien à lui de le faire.

(Ci-dessous des screenshots hébergés sur Servimg.com)

Télécharger le Fichier «Graphique empile 100.accdb» à partir de Archives-Host.com

Report_Graph1

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
 
Option Compare Database
Option Explicit
Dim XPageDroite As Single, YPageBas As Single
Dim XGraphGauche As Single, YGraphHaut As Single
Dim XGraphDroite As Single, YGraphBas As Single
Dim XInterval As Single, YInterval As Single
Dim YPas As Integer
Dim Espacement As Integer
Dim XSérie1 As Single, YSérie1 As Single, YSérie2 As Single, YSérie3 As Single
___________________________________________________
Private Sub PiedGroupe1_Format(Cancel As Integer, FormatCount As Integer)
Données
End Sub
 
___________________________________________________
Private Sub Report_Page()
'Nota : 1cm = 567 twips
Dim F As Integer
Dim Titre As String, Étiquette As String
 
 
XPageDroite = Me.ScaleWidth - 10
YPageBas = Me.ScaleHeight - 10
XGraphGauche = XPageDroite / 10
YGraphHaut = YPageBas / 10
XGraphDroite = XPageDroite - XGraphGauche
YGraphBas = YPageBas - YGraphHaut
YPas = 10
XInterval = Format((XGraphDroite - XGraphGauche) / NbrEnregistrements, "0.000")
YInterval = Format((YGraphBas - YGraphHaut) / YPas, "0.000")
Espacement = 90 ' valeur en % max 100% min 0%
 
'Trace un rectangle autour de la page
Me.Line (0, 0)-(XPageDroite, YPageBas), vbBlack, B
 
'Trace le Titre du Graphique
Titre = "Graphique empilé 100%"
    With Me
        .FontName = "Arial"
        .FontSize = 20
        .FontBold = True
        .CurrentX = (Me.ScaleWidth - Me.TextWidth(Titre)) / 2    ' centrage en X
        .CurrentY = (YGraphHaut - Me.TextHeight(Titre)) / 2  ' centrage en Y
    End With
    Me.Print Titre
 
'Trace les marques Horizontales
For F = 1 To NbrEnregistrements - 1
Me.Line (XGraphGauche + (XInterval * F), YGraphBas - 50)-(XGraphGauche + (XInterval * F), YGraphBas + 50), vbBlack
Next
 
'Trace les marques Verticales gauche
For F = 1 To 9
Me.Line (XGraphGauche - 50, YGraphHaut + (YInterval * F))-(XGraphGauche + 50, YGraphHaut + (YInterval * F)), vbBlack
Next
 
'Trace la grille horizontale
For F = 1 To 9
Me.Line (XGraphGauche, YGraphHaut + (YInterval * F))-(XGraphDroite, YGraphHaut + (YInterval * F)), vbBlack
Next
 
'Trace les étiquettes Horizontales centrées entre les marques horizontales
For F = 0 To NbrEnregistrements - 1
Étiquette = Enregistrements(F, 0)
    With Me
        .FontName = "Arial"
        .FontBold = True
        .FontSize = 10
            Do While (Me.TextWidth(Étiquette) > XInterval) And .FontSize > 4
            .FontSize = .FontSize - 1
            Loop
        .CurrentX = (XGraphGauche + (XInterval * F)) + ((XInterval - Me.TextWidth(Étiquette)) / 2)
        .CurrentY = YGraphBas + Me.TextHeight(Étiquette)
    End With
    Me.Print Étiquette
Next
 
'Trace les étiquettes verticales gauches sur les marques verticales gauches
Étiquette = "0"
For F = 0 To YPas
Étiquette = Format((YPas * YPas) - (YPas * F), "0.00") & " %"
 
    With Me
        .FontName = "Arial"
        .FontBold = True
        .FontSize = 10
            Do While (Me.TextHeight(Étiquette) > YInterval) And .FontSize > 4
            .FontSize = .FontSize - 1
            Loop
        .CurrentX = XGraphGauche - Me.TextWidth(Étiquette) - 100
        .CurrentY = (YGraphHaut + (YInterval * F)) - (Me.TextHeight(Étiquette) / 2)
    End With
    Me.Print Étiquette
Next
 
'Trace les séries
For F = 0 To NbrEnregistrements - 1
    XSérie1 = (XGraphGauche + (XInterval * F)) + ((XInterval - (XInterval * (Espacement / 100))) / 2)
    YSérie1 = YGraphHaut + ((YGraphBas - YGraphHaut) * (Enregistrements(F, 1) / 100))
    YSérie2 = YSérie1 + ((YGraphBas - YGraphHaut) * (Enregistrements(F, 2) / 100))
    YSérie3 = YSérie2 + ((YGraphBas - YGraphHaut) * (Enregistrements(F, 3) / 100))
 
    Me.Line (XSérie1, YGraphHaut)-(XSérie1 + (XInterval * (Espacement / 100)), YSérie1), vbGreen, BF
    Me.Line (XSérie1, YSérie1)-(XSérie1 + (XInterval * (Espacement / 100)), YSérie2), vbRed, BF
    Me.Line (XSérie1, YSérie2)-(XSérie1 + (XInterval * (Espacement / 100)), YSérie3), vbBlue, BF
Next
 
'Trace un rectangle "Zone de graphique"
Me.Line (XGraphGauche, YGraphHaut)-(XGraphDroite, YGraphBas), vbBlack, B
 
End Sub

Module1

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
 
Option Compare Database
Option Explicit
 
Public Enregistrements(100, 3)
Public NbrEnregistrements
 
___________________________________________________
Public Sub Données()
'Récupère les valeurs pour les stocker dans une variables
'Convertie les valeurs en pourcentage
Enregistrements(NbrEnregistrements, 0) = Report_Graph1.Mdate.Value
Enregistrements(NbrEnregistrements, 1) = (Report_Graph1.Donnée_1.Value / (Report_Graph1.TotalDonnées)) * 100
Enregistrements(NbrEnregistrements, 2) = (Report_Graph1.Donnée_2.Value / (Report_Graph1.TotalDonnées)) * 100
Enregistrements(NbrEnregistrements, 3) = (Report_Graph1.Donnée_3.Value / (Report_Graph1.TotalDonnées)) * 100
 
NbrEnregistrements = Report_Graph1.CurrentRecord
 
End Sub