- 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² ::.
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² ::.