Histogramme
Description
Cela permet d'afficher ou d'imprimer vos données sous forme d'histogramme.
Il est possible de la même façon de générer d'autre type de graphique.
Source / Exemple :
Option Explicit
Dim Tableau1() As Integer 'J'aurais bien voulu utiliser un tableau multidimension du type Tableau(14,1)
Dim Tableau2() As String 'mais on ne peut redimensionner ce genre de tableau
'Cependant pour ceux qui peuvent exploiter des tables à taille fixe c'est possible
Dim i As Integer
Dim taille As Integer
Function Graph(Largeur As Integer, Titre As String, Ecran As Boolean)
Dim X As Object
If Ecran Then Set X = Form1 Else Set X = Printer
If Ecran Then X.Cls
X.Font = "Arial"
X.ScaleMode = 6
X.FillStyle = 0
X.Print Titre
X.Line (20, 20)-(20, 120)
X.Line (19, 20)-(21, 20)
X.CurrentX = 12
X.CurrentY = 18
X.Print "100%"
X.Line (19, 45)-(21, 45)
X.CurrentX = 13
X.CurrentY = 43
X.Print "75%"
X.Line (19, 70)-(21, 70)
X.CurrentX = 13
X.CurrentY = 68
X.Print "50%"
X.Line (19, 95)-(21, 95)
X.CurrentX = 13
X.CurrentY = 93
X.Print "25%"
X.Line (19, 120)-(21, 120)
X.CurrentX = 14
X.CurrentY = 118
X.Print "0%"
X.FontSize = 6
For i = 0 To UBound(Tableau1)
X.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) 'Il serait facile d'installer une legende avec la couleur juste avec un tableau supplementaire
X.Line (25 + i * Largeur * 2, 120)-Step(Largeur, -Tableau1(i)), , B
X.CurrentX = (25 + (Largeur / 2)) + i * Largeur * 2
X.CurrentY = 123
X.Print CStr(i)
Next i
X.Line (20, 120)-(22 + i * Largeur * 2, 120)
X.Print
X.Print
X.Print
X.Print
For i = 0 To UBound(Tableau1)
X.Print "N°" + CStr(i) + " " + Tableau2(i) + " " + CStr(Tableau1(i)) + "%" 'Vous pouvez afficher les valeurs dans une List ou un ListView par ex.
Next i
If Ecran = False Then X.EndDoc
End Function
Private Sub Command1_Click()
'Impression du graphique
taille = 190 / (2 * (UBound(Tableau1) + 1)) ' Autosize pour du A4 (210x297)
Call Graph(taille, "Test", False)
End Sub
Private Sub Form_Activate()
'Affichage du graphique
taille = (Me.ScaleWidth - 30) / (2 * (UBound(Tableau1) + 1)) ' Vous pouvez aussi adapter la taille en hauteur
Call Graph(taille, "Test", True)
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True 'Important pour l'affichage
Me.ScaleMode = 6 'Millimétre
'EXEMPLE ---------------------------
ReDim Tableau1(14)
ReDim Tableau2(14)
Tableau1(0) = 64
Tableau2(0) = "Fournisseur1"
Tableau1(1) = 25
Tableau2(1) = "Fournisseur2"
Tableau1(2) = 89
Tableau2(2) = "Fournisseur3"
Tableau1(3) = 17
Tableau2(3) = "Fournisseur4"
Tableau1(4) = 100
Tableau2(4) = "Fournisseur5"
Tableau1(5) = 65
Tableau2(5) = "Fournisseur6"
Tableau1(6) = 2
Tableau2(6) = "Fournisseur7"
Tableau1(7) = 94
Tableau2(7) = "Fournisseur8"
Tableau1(8) = 52
Tableau2(8) = "Fournisseur9"
Tableau1(9) = 15
Tableau2(9) = "Fournisseur10"
Tableau1(10) = 8
Tableau2(10) = "Fournisseur11"
Tableau1(11) = 77
Tableau2(11) = "Fournisseur12"
Tableau1(12) = 32
Tableau2(12) = "Fournisseur13"
Tableau1(13) = 29
Tableau2(13) = "Fournisseur14"
Tableau1(14) = 90
Tableau2(14) = "Fournisseur15"
'-------------------------------- ----
End Sub
Private Sub Form_Resize()
taille = (Me.ScaleWidth - 30) / (2 * (UBound(Tableau1) + 1)) ' Autosize pour du A4 (210x297). Le mode paysage est exploitable si on veut
Call Graph(taille, "Test", True)
End Sub
'Ce code peut être largement amélioré. C'est juste une base pour ceux qui ne veulent pas utiliser l'OCX
'Valentino .:: J² ::.
Conclusion :
Il est possible de la même façon de générer d'autre type de graphique.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.