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
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
Function Export_to_Excel(paramvalue As String)
'fonction d'export de la requete paramétrée vers excel
'Declaration
Dim oXLApp As Object ' *** Excel.Application
Dim oWork As Workbook 'nom du classeur excel
Dim oFeuille As Worksheet 'nom de la feuille excel
Dim j As Long 'utilisé pour les colonnes
Dim I As Long 'utilisé pour les lignes
Dim qdf As QueryDef 'requete
Dim rst As DAO.Recordset
Dim fld As DAO.Field
Dim nb As Long 'nombre de lignes (+1) du fichier
'Création de l'application excel
Set oXLApp = CreateObject("Excel.Application")
'création du classeur
Set oWork = oXLApp.Workbooks.Add
'création de la feuille
Set oFeuille = oWork.Worksheets(1)
'ouvre la requete dans un recordset en attribuant le client sélectionné dans la liste au paramètre de la requete
Set qdf = CurrentDb.CreateQueryDef("essais_un_client_res", "PARAMETERS [critereclient] string ; SELECT * FROM essais_un_client WHERE client_code = [critereclient];")
qdf.Parameters(0) = paramvalue 'valeur du paramètre critereclient
Set rst = qdf.OpenRecordset 'on ouvre le recordset
'Pour différencier les différentes parties du fichier, je mets différentes couleurs et différents
'titres à chaque partie
'Partie concernant la description de l'essai
For j = 1 To 19
oFeuille.Cells(1, 9).Interior.ColorIndex = 20 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 20 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 9) = "Essai" 'titre de la partie
oFeuille.Cells(1, 9).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
'Partie concernant le rapport de l'essai
For j = 20 To 28
oFeuille.Cells(1, 23).Interior.ColorIndex = 36 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 36 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 23) = "Rapport" 'titre de la partie
oFeuille.Cells(1, 23).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
'Partie concernant les actions de l'essai
For j = 29 To 34
oFeuille.Cells(1, 30).Interior.ColorIndex = 42 'couleur de la cellule contenant le titre de la partie
oFeuille.Cells(2, j).Interior.ColorIndex = 42 'couleur des cellules contenant les en-tetes
oFeuille.Cells(1, 30) = "Actions" 'titre de la partie
oFeuille.Cells(1, 30).HorizontalAlignment = xlCenter 'centre le titre dans la cellule
Next j
' le titre de la page dans la cellule de ligne 1 et de colonne 1
oFeuille.Cells(1, 2) = "Liste des essais du client : " & paramvalue
oFeuille.Cells(1, 2).Font.Bold = True 'texte de la cellule en gras
'Nom des en-tetes de chaque colonne
For j = 0 To rst.Fields.Count - 1 'rec.fields.count compte le nombre de colonnes du fichier
oFeuille.Cells(2, 1) = "Client"
oFeuille.Cells(2, 2) = "N° essai"
oFeuille.Cells(2, 3) = "Type"
oFeuille.Cells(2, 4) = "Site"
oFeuille.Cells(2, 5) = "Homologation"
oFeuille.Cells(2, 6) = "N° PV"
oFeuille.Cells(2, 7) = "type du produit"
oFeuille.Cells(2, 8) = "culture"
oFeuille.Cells(2, 9) = "Nom de l'agriculteur"
oFeuille.Cells(2, 10) = "Prénom de l'agriculteur"
oFeuille.Cells(2, 11) = "Code postal"
oFeuille.Cells(2, 12) = "lieu de l'essai"
oFeuille.Cells(2, 13) = "Début"
oFeuille.Cells(2, 14) = "Prévision ou non"
oFeuille.Cells(2, 15) = "Fin"
oFeuille.Cells(2, 16) = "Prévision ou non"
oFeuille.Cells(2, 17) = "PA"
oFeuille.Cells(2, 18) = "PE"
oFeuille.Cells(2, 19) = "CE"
oFeuille.Cells(2, 20) = "Format ARM"
oFeuille.Cells(2, 21) = "Exigence rapport à Pau"
oFeuille.Cells(2, 22) = "Arrivée rapport à Pau"
oFeuille.Cells(2, 23) = "COM format"
oFeuille.Cells(2, 24) = "COM langue"
oFeuille.Cells(2, 25) = "Type fichier à fournir"
oFeuille.Cells(2, 26) = "Draft demandé"
oFeuille.Cells(2, 27) = "Divers"
oFeuille.Cells(2, 28) = "Rapport final prêt pour facturation"
oFeuille.Cells(2, 29) = "Nature"
oFeuille.Cells(2, 30) = "Nom"
oFeuille.Cells(2, 31) = "Date"
oFeuille.Cells(2, 32) = "Prévision"
oFeuille.Cells(2, 33) = "Commentaire"
oFeuille.Cells(2, 34) = "Information envoyée au client le"
' mise en forme des cellules contenant les en-tetes
With oFeuille.Cells(2, j + 1) 'pour toutes les cellules de la lignes 2
.Borders(xlEdgeBottom).LineStyle = xlContinuous 'style de la bordure du bas en trait continu
.Borders(xlEdgeBottom).Weight = xlThin 'épaisseur de la bordure du bas en trait fin
.Borders(xlEdgeBottom).ColorIndex = xlAutomatic 'couleur de la bordure du bas automatique = noir
.Borders(xlEdgeTop).LineStyle = xlContinuous 'style de la bordure du haut en trait continu
.Borders(xlEdgeTop).Weight = xlThin 'épaisseur de la bordure du haut en trait fin
.HorizontalAlignment = xlCenter 'texte centré dans la cellule
End With
Next j
' copie le contenu du recordset dans la feuille excel à partir
'de la ligne 3 car les en-tetes sont dans la ligne 2
'oFeuille.Cells(3, 1).CopyFromRecordset rst
nb = 3
I = 3
Do While Not rst.EOF 'tant qu'on n'est pas à la fin du fichier
For j = 1 To rst.Fields.Count - 1 'pour chaque colonne du fichier
' .Fields(Index).Type renvoie le type du champ
' si c'est un Texte (dbText)
If rst.Fields(j).Type = dbText Then
'on insèrons "'" pour qu'il soit reconnu par Excel comme du Texte
oFeuille.Cells(I, j + 1) = "'" & rst.Fields(j)
Else
oFeuille.Cells(I, j + 1) = rst.Fields(j)
End If
'pour les types oui/non, les cases d'excel se remplissent avec VRAI (=oui) ou FAUX (=non)
'si c'est "FAUX"
If rst.Fields(j).Value = "FAUX" Then
'on remplace par la cellule vide
oFeuille.Cells(I, j + 1) = ""
Else
'si c'est "VRAI"
If rst.Fields(j).Value = "VRAI" Then
oFeuille.Cells(I, j + 1) = "x" 'on remplace par "x"
oFeuille.Cells(I, j + 1).HorizontalAlignment = xlCenter 'on centre le "x" dans la cellule
End If
End If
'on ajuste automatiquement la taille de chaque colonne en fonction du texte qu'elle contient
oFeuille.Columns("A:AY").EntireColumn.AutoFit
'Pour chaque date, si c'est une prévision, c'est à dire si la colonne suivante contient "x"
'on met la date en rouge
If oFeuille.Cells(I, 14) = "x" Then
oFeuille.Cells(I, 13).Font.ColorIndex = 3 'date en rouge
End If
If oFeuille.Cells(I, 16) = "x" Then
oFeuille.Cells(I, 15).Font.ColorIndex = 3 'date en rouge
End If
If oFeuille.Cells(I, 32) = "x" Then
oFeuille.Cells(I, 31).Font.ColorIndex = 3 'date en rouge
End If
'On cache les colonnes de prévision, c'est à dire les colonnes contenant "x"
oFeuille.Range("N:N").EntireColumn.Hidden = True
oFeuille.Range("P:P").EntireColumn.Hidden = True
oFeuille.Range("AF:AF").EntireColumn.Hidden = True
'On cache egalement la colonne contenant le nom du client
oFeuille.Range("A:A").EntireColumn.Hidden = True
Next j
nb = nb + 1 'on compte le nombre de lignes remplies
'le format date n'est pas conservé lors de l'exportation
'on met chaque colonne contenant des dates au format date
oFeuille.Cells(I, 13).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 15).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 21).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 22).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 28).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 31).NumberFormat = "dd/mm/yyyy"
oFeuille.Cells(I, 34).NumberFormat = "dd/mm/yyyy"
'passage à la ligne suivante
I = I + 1
rst.MoveNext
Loop
'pour chaque ligne correspondant à un meme essai, on enleve toute
'la partie identique pour ne laisser que les actions (qui sont différentes), excepté sur la première ligne
'il faut aussi séparer les lignes correspondants à des essais différents
For I = nb To 1 Step -1 'on démarre à la derniere ligne
'si la deuxieme cellule (le numero d'essai) est égale a la deuxieme cellule de la ligne précédente
If oFeuille.Cells(I, 2) = oFeuille.Cells(I + 1, 2) Then
For j = 2 To 27 'pour chaque colonnes jusqu'à la 27
oFeuille.Cells(I + 1, j) = "" 'on vide les cellules
Next j
Else
For j = 1 To 34 'pour chaque cellule de la ligne
With oFeuille.Cells(I + 1, j).Borders(xlEdgeTop) 'on met une bordure supérieure pour différencier
'l'essai de celui de la ligne précédente
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
Next j
End If
Next I
For I = 2 To nb - 1 'pour chaque ligne du fichier
For j = 1 To 34 'pour chaque colonne
With oFeuille.Cells(I, j).Borders(xlEdgeLeft) 'création d'une bordure a gauche
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
With oFeuille.Cells(I, j).Borders(xlEdgeRight) 'création d'une bordure a droite
.LineStyle = xlContinuous 'style de la bordure en trait continu
.Weight = xlThin 'épaisseur de la bordure en trait fin
.ColorIndex = xlAutomatic 'couleur de la bordure automatique = noir
End With
oFeuille.Cells(I, j).HorizontalAlignment = xlCenter 'centrer le texte de chaque cellule
Next j
Next I
oXLApp.Visible = True
rst.Close
qdf.Close
Set rst = Nothing
Set qdf = Nothing
CurrentDb.QueryDefs.Delete "essais_un_client_res"
Set oFeuille = Nothing
Set oWork = Nothing
Set oXLApp = Nothing
End Function |
optimiser export vers excel
Répondre avec citation
Partager