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 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
| '==== INITIALISATION DES GRAPHIQUES ============================
'On crée les nouveaux graphiques Excel 5.0 dans le contrôle OLE :
frm_R5.ole_graph.CreateEmbed "", "Excel.Chart.5"
frm_R5.ole_graph2.CreateEmbed "", "Excel.Chart.5"
'On assigne les références d'objet aux objets Graphique, Feuille et Application :
If Left(frm_R5.ole_graph.object.Application.Version, 1) = "7" Then
Set objChart = frm_R5.ole_graph.object
Else
Set objChart = frm_R5.ole_graph.object.ActiveChart
End If
If Left(frm_R5.ole_graph2.object.Application.Version, 1) = "7" Then
Set objChart2 = frm_R5.ole_graph2.object
Else
Set objChart2 = frm_R5.ole_graph2.object.ActiveChart
End If
Set objSheet = objChart.Parent.Worksheets(1) 'Représente la feuille de données sources pour le graphique
Set objSheet2 = objChart2.Parent.Worksheets(1)
Set objXL = objChart.Application 'Représente l'application
Set objXL2 = objChart2.Application
objSheet.Cells.Clear
objSheet2.Cells.Clear
'[....] Initialisations des variables [.....]
'GRAPHIQUE 1 ==================================================
'On crée les labels
RSup1.MoveFirst
For i = 1 To cRowsA
objSheet.Cells(i + 1, 1).Value = RSup1.Fields("NUM_SAMPLE").Value
RSup1.MoveNext
Next
For i = 0 To cColsB - 1
objSheet.Cells(1, i + 2).Value = Me.txt_selection.List(i)
Next
'==============================================
'LES DONNEES / DATA
For iCol = 0 To cColsB - 1
lenumsample = 0
For iRow = 0 To cRowsA - 1
lenumsample = lenumsample + 1
larequete2 = "SELECT VAL_DIRECT FROM TBSCT.EPE_VIB_RELEVECONT WHERE LIB_CAPTEUR='" & tab_capteurs(0) & "' AND DATEESSAI = " & tab_dates(iCol) & " AND TURCO = " & tab_turcos(iCol) & " AND NUM_SAMPLE='" & lenumsample & "'" ' ORDER BY TURCO,DATEESSAI,MOMENT_RELEVE_CONT"
If (mdbTools.GetRecordset(CN, larequete2, RSup2)) = False Then MsgBox "erreur de requête"
If (RSup2 Is Nothing) Then Call ExitProcess(1)
If RSup2.RecordCount > 0 Then
If RSup2.Fields("VAL_DIRECT").Value <> "" Then
objSheet.Cells(iRow + 2, iCol + 2).Value = CDec(RSup2.Fields("VAL_DIRECT").Value)
Else
objSheet.Cells(iRow + 2, iCol + 2).Value = 0
End If
End If
Next
If (Not RSup2 Is Nothing) Then
If (RSup2.State = adStateOpen) Then RSup2.Close
Set RSup2 = Nothing
End If
Next
'==============================================
'CONSTRUCTION DU GRAPHIQUE --------------------
'On nomme la plage qui contient les données précédemment ajoutées :
objSheet.Range(objSheet.Cells(1, 1), objSheet.Cells(cRowsA + 1, cColsB + 1)).Name = "ChartDataRange"
'On définit les paramètres du CharWizard :
cwSource = "ChartDataRange" 'Nom de la plage nommée / Name of Named Range
cwGallery = 4 'Type de graphique / Chart type
cwFormat = 2 'Format du type de graphique / Format of Chart Type
cwPlotBy = xlColumns 'Orientation des séries / Series orientation
cwCategoryLabels = 1 '1 ligne contient les labels de catégorie / 1 Row contains Category Labels
cwSeriesLabels = 1 '1 colonne contient les labels de série / 1 Column contains Series Labels
cwHasLegend = 1 'Affiche la légende / Display the Legend
cwTitle = Me.txt_selection.List(0) & " - DIRECT" 'Titre du graphique / Chart Title
cwValueTitle = "" 'Titre des valeurs / Value Title
objChart.Axes(xlValue).MinimumScale = 0 'Echelle mini / Min scale
objChart.Axes(xlValue).MaximumScaleIsAuto = True 'Echelle maxi -> Auto / Max scale -> Auto
'On utilise la méthode ChartWizard pour remplir le graphique :
objChart.ChartWizard cwSource, cwGallery, cwFormat, cwPlotBy, cwCategoryLabels, _
cwSeriesLabels, cwHasLegend, cwTitle, , cwValueTitle
'--------------------------------------------------
'Je referme la requete
If (Not RSup2 Is Nothing) Then
If (RSup2.State = adStateOpen) Then RSup2.Close
Set RSup2 = Nothing
End If
'DE LA MEME MANIERE,ON CONSTRUIT LE GRAPHIQUE 2
'GRAPHIQUE 2 =======================================================
RSup1.MoveFirst
For i = 1 To cRowsA
objSheet2.Cells(i + 1, 1).Value = RSup1.Fields("NUM_SAMPLE").Value
RSup1.MoveNext
Next
For i = 0 To cColsB - 1
objSheet2.Cells(1, i + 2).Value = Me.txt_selection.List(i)
Next
'==============================================
'LES DONNEES / DATA
For iCol = 0 To cColsB - 1
lenumsample = 0
For iRow = 0 To cRowsA - 1
lenumsample = lenumsample + 1
larequete2 = "SELECT VAL_AMPL FROM TBSCT.EPE_VIB_RELEVECONT WHERE LIB_CAPTEUR='" & tab_capteurs(0) & "' AND DATEESSAI = " & tab_dates(iCol) & " AND TURCO = " & tab_turcos(iCol) & " AND NUM_SAMPLE='" & lenumsample & "'" ' ORDER BY TURCO,DATEESSAI,MOMENT_RELEVE_CONT"
If (mdbTools.GetRecordset(CN, larequete2, RSup2)) = False Then MsgBox "erreur de requête"
If (RSup2 Is Nothing) Then Call ExitProcess(1)
If RSup2.RecordCount > 0 Then
If RSup2.Fields("VAL_AMPL").Value <> "" Then
objSheet.Cells(iRow + 2, iCol + 2).Value = CDec(RSup2.Fields("VAL_AMPL").Value)
Else
objSheet.Cells(iRow + 2, iCol + 2).Value = 0
End If
End If
Next
If (Not RSup2 Is Nothing) Then
If (RSup2.State = adStateOpen) Then RSup2.Close
Set RSup2 = Nothing
End If
Next
'==============================================
'CONSTRUCTION DU GRAPHIQUE --------------------
objSheet2.Range(objSheet2.Cells(1, 1), objSheet2.Cells(cRowsA + 1, cColsB + 1)).Name = "ChartDataRange"
cwSource = "ChartDataRange"
cwGallery = 4
cwFormat = 2
cwPlotBy = xlColumns
cwCategoryLabels = 1
cwSeriesLabels = 1
cwHasLegend = 1
cwTitle = Me.txt_selection.List(0) & " - 1X"
cwValueTitle = ""
objChart2.Axes(xlValue).MinimumScale = 0
objChart2.Axes(xlValue).MaximumScaleIsAuto = True
objChart2.ChartWizard cwSource, cwGallery, cwFormat, cwPlotBy, cwCategoryLabels, _
cwSeriesLabels, cwHasLegend, cwTitle, , cwValueTitle
'--------------------------------------------------
If (Not RSup2 Is Nothing) Then
If (RSup2.State = adStateOpen) Then RSup2.Close
Set RSup2 = Nothing
End If |
Partager