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
| Public Function InitialisationGraphOLE(GraphOLE As Object, _
RequeteGraphique As String, TitreGraphique As String, TypeGraphique As String, Optional YScale As Long = 1000)
Dim RST As DAO.Recordset
Dim GOLE As Chart
Set GOLE = GraphOLE.object
ErreurRequete = ""
' Initialisation de la requete
If (RequeteGraphique <> "") Then
If QueryDefExist("QTemp_G") Then
DoCmd.DeleteObject acQuery, "QTemp_G"
CurrentDb.CreateQueryDef "QTemp_G", RequeteGraphique
Else
CurrentDb.CreateQueryDef "QTemp_G", RequeteGraphique
End If
'MsgBox VarType(CurrentDb.OpenRecordset("QTemp_G", dbReadOnly))
Set RST = CurrentDb.OpenRecordset("QTemp_G", dbReadOnly)
If RST.RecordCount > 0 Then
GraphOLE.RowSource = RequeteGraphique
Else
ErreurRequete = "Aucun enregistrement n'a été retourné suite à votre séléction. Le formulaire de sélection est réinitilisé sur l'indicateur par défaut."
End If
'Call DetruireRecordSetTemporaire(RST)
DoCmd.DeleteObject acQuery, "QTemp_G"
End If
If ErreurRequete = "" Then
' Initialisation du Titre
If (RequeteGraphique <> "") Then GOLE.ChartTitle.Text = TitreGraphique
' Initialisation Type Graphique
With GOLE
Select Case TypeGraphique
Case "Histogramme"
.ChartType = xlColumnClustered ' Histo
Case "Courbe"
.ChartType = xlLineMarkers ' Courbe
Case "Cylindre"
.ChartType = xlCylinderColClustered ' Cylindres
Case Else
' .ChartType = xlCylinderColClustered ' Cylindres
.ChartType = xlColumnClustered ' Histo
End Select
' Initialisation echelle Mesure Indicateur : Millier, Million
'GOLE.SeriesCollection(1) . .Verb Verb:=xlPrimary
'Axes
' .Axes(xlValue).MinorUnitIsAuto = True
' .Axes(xlValue).MajorUnitIsAuto = True
' .Axes(xlValue).MinimumScaleIsAuto = True
' .Axes(xlValue).MaximumScaleIsAuto = True
Select Case YScale
Case 100
.Axes(xlValue).DisplayUnit = xlHundreds
Case 1000
.Axes(xlValue).DisplayUnit = xlThousands
Case 1000000
.Axes(xlValue).DisplayUnit = xlMillions
Case Else
.Axes(xlValue).DisplayUnit = xlNone
End Select
.Axes(xlValue).HasDisplayUnitLabel = True
' Légende
.Legend.Font.Size = 8
.Legend.Border.Weight = 1
.Legend.Position = xlLegendPositionRight
End With
'Initialisation Série
End If
Set RST = Nothing
InitialisationGraphOLE = ErreurRequete
End Function |
Partager