Création de graphique au départ d'une table

Version imprimable

02/10/2020, 15h52
Dermochelys

1 pièce(s) jointe(s)

Création de graphique au départ d'une table

Bonjour,

Au départ d'une table Access, je souhaiterai créer un graphique un peu complexe via du codage VBA (je m'en sors assez là-dedans). J'ai bien lu le superbe tuto de jean-Philippe Ambrosino (et l'ai déjà appliqué dans le passé pour des histogrammes et autres courbes). Mais malgré ça, je ne vois pas trop par quel bout prendre celui-ci.
Ce dernier gaphique comprends deux séries de données de températures, trois séries de données (précipitations+humidité), et les données concernant des dates d'éclosion et de pontes de différents insectes (dates de pontes estimées sur base de variables différentes, c'est pour cela qu'il y a des -a,-b,-c)
Aussi avant de me lancer, je voulais avoir vos avis éclairés (si possible ;) ) sur le processus et surtout sur le code VBA que je dois mettre en oeuvre.... Cela peut être un graphique dans Access (et que l'utilisateur pourra copier-coller) ou dans excel (piloté depuis Access)... Mais j'avoue que je préfère la première solution.

Je joins un fichier excel qui reprends un exemple de données (de la table) et du graphique auquel je voudrais arriver.

En attendant le plaisir de vous lire, je vous souhaite une très bon weekend.

Bonjour,

Vous pourriez exporter en vba une série dans une plage de cellules Excel :

Code:

ws.Cells(1, 1).CopyFromRecordset rs ' copie de la série à partir de la cellule (1,1) de la feuille

rs étant un recordset contenant votre série de données.

Puis, lier votre graphique Excel à cette série, voici un exemple de code VBA :
Code:

1 2 3 4 5 6 7 Set ch = ws.ChartObjects(1) ' référence à l'objet graphique dans la feuille ws l = ws.Cells(ws.Columns(1).Cells.Count, 1).End(xlup).Row ' nombre de lignes de la série copiée ch.Chart.SetSourceData ws.Range("A1:B" & l), PlotBy:=xlcolumns ' on définit la source et le type de graphique ch.Chart.ChartTitle.Text = Titre
Après il y a certainement moyen de le faire sous Access, d'autant qu'ils ont bien amélioré les graphiques dans les dernières versions.

Cdlt,

05/10/2020, 10h13
Dermochelys

Bonjour User,

Merci pour ta réponse. je ne connaissais pas cette possibilité d'exportation et de liaison avec un graphique. Intéressant :)

Mais cela implique que le graphique doit avoir déjà été créer dans un fichier de destination pour qu'il puisse être "alimenter" par les données.

Dans mon cas, à chaque fois, j'exporte les données au cas par cas dans un nouveau fichier excel.... faudra que je fasse un template peut-être... je vais y réfléchir....

Sinon dans Access, je vais essayer de construire cela mais ça m'a l'air compliqué avec les 2 axes Y et les formatages des différentes séries :) Un challenge de plus !

Belle journée à toi!

Bonjour User,

Bon... j'ai un soucis...

Suite a d'autres recherche et discussions du forum, j'ai décidé de passé par la création d'un fichier excel (xlsx) qui servira de base.
Ce fichier contient juste une feuille sur laquelle j'ai des données bidons et un graphique fait à partir de ces données.
A cette feuille se rajoutent aussi différentes feuilles que je crèent (ca fonctionne parfaitement cet aspect là).

Mon idée est de remplacer les données bidons de la feuille de calcul (qui contient un graphique) par les bonnes provenant d'un recordset (rec3) que j'ai élagué et retravaillé.

Code:

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
 
'''' au début de ma sub je déclare
 
    'Initialisations
    sFichierExcel = strChemin & "\seed_graph2.xlsx"
    Set xlApp = CreateObject("Excel.Application")
 
    'on teste si le fichier seed_graph2 existe et s'il est disponible = pas ouvert déjà
    bFichierExiste = False
    If Len(Dir(sFichierExcel, vbNormal)) > 0 Then
       bFichierExiste = True
       ' Si fichier ouvert, afficher un message et sortir
       If IsFileOpen(sFichierExcel) Then
          MsgBox "Veuillez fermer le fichier '" & sFichierExcel & "'  SVP"
          Exit Sub
       End If
    End If
 
    If bFichierExiste Then    ' Si le fichier existe on l'ouvre
        Set xlBook = xlApp.Workbooks.Open(sFichierExcel)
    Else    ' Sinon on le crée
        Set xlBook = xlApp.Workbooks.ADD     'ceci au cas où, on aurait déplacer ou effacer le fichier, il faut quand même pouvoir sauver les infos dans le classeur à raison d'une table par feuille
    End If
 
 
''''' ici il y a le code de construction du recordset rec3 qui va être exporté sur la feuille excel "graphique"
 
 
''''' on sélectionne la feuille nomée "graphique" pour y copier le recordet
            xlBook.xlSheet("graphique").Select
            ' les entetes des champs sont sur la ligne 3
            For j = 0 To rec3.Fields.count - 1
                xlSheet.Cells(3, j + 1) = rec3.Fields(j).Name
                ' Nous appliquons des enrichissements de format aux cellules
                With xlSheet.Cells(3, j + 1)
                    .Interior.ColorIndex = 15
                    '.Font.Bold = True
                    .Interior.Pattern = xlSolid
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).weight = xlThin
                    .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
                    .HorizontalAlignment = xlCenter
                End With
            Next j
            xlSheet.Cells(1, 4).CopyFromRecordset rec3 ' copie du recordset à partir de la cellule (1,4) de la feuille
 
 
 
'... et plus loin je ferme
 
        xlBook.Close True  ' sauve le workbook 
        xlApp.Quit

Le problème c'est que j'ai une erreur 91 (variable objet ou avec une variable de bloc qui n'est pas définie). Ce qui fait aussi que mon fichier excel ne se sauve pas.
Je pense que cela vient de ma déclaration de la feuille cible... ou quelque chose lié à ça...
Est-ce que tu as des suggestions pour m'aider à corriger ça?

Bonne fin de journée dans tous les cas :)

08/10/2020, 18h34
User

Bonsoir,

J'ai écrit un billet sur les bonnes pratiques concernant le pilotage d'Excel depuis Access.

J'espère que ça t'aidera, car c'est un peu compliqué de déchiffrer le code d'une autre personne. Sauf à te conseiller de créer des variables objet séparées pour chaque objet auquel tu fais référence, et bien libérer la mémoire à la fin. Assures toi aussi qu'un objet faisant référence au classeur n'est pas déjà chargé en mémoire.

Cdlt

bonsoir,

Citation:

Le problème c'est que j'ai une erreur 91 (variable objet ou avec une variable de bloc qui n'est pas définie). Ce qui fait aussi que mon fichier excel ne se sauve pas.

sur quelle ligne l'erreur se produit-elle ?

Citation:

Envoyé par USer

J'espère que ça t'aidera, car c'est un peu compliqué de déchiffrer le code d'une autre personne.

d'autant que ce code est incomplet ... ce qui rend encore plus difficile une réponse possible:
Code:

1 2 3 4 5 6 7 8 9 Set xlBook = xlApp.Workbooks.Open(sFichierExcel) Else ' Sinon on le crée Set xlBook = xlApp.Workbooks.ADD 'ceci au cas où, on aurait déplacer ou effacer le fichier, il faut quand même pouvoir sauver les infos dans le classeur à raison d'une table par feuille End If ''''' ici il y a le code de construction du recordset rec3 qui va être exporté sur la feuille excel "graphique" ''''' on sélectionne la feuille nomée "graphique" pour y copier le recordet xlBook.xlSheet("graphique").Select
où sont la déclaration et l'affectation de la feuille "graphique" dans le cas où on crée le classeur ?

Bonjour User, tee_grandbois,

Merci pour vos pistes et suggestions. Je vois cela de près cette semaine :) Dès que j'ai un peu de temps je compléterai le code du premier post, pour être plus lisible (dsl, j'ai voulu faire au plus court).

@ tee_grandbois: Je ne comprends pas trop tes dernières questions...
Au départ, j'ai mon fichier avec une seule feuille contenant le graphique. Dans mon code (a améliorer encore), j'envisage la possibilité que l'on ne souhaiterai pas avoir de graphique, donc pas besoin d'avoir une feuille déclaré et affectée à ce graphique (mais juste un classeur qu'on crée de novo , et auquel on ajoute les feuilles de calculs).
Sinon, s'il fallait déclarer et affecter la feuille graphique pour un classeur créé à partir de rien (donc sans le fichier de base déjà prêt), j'avoue que je ne vois pas trop comment faire. Car outre la déclaration et l'affectation, il faudrait que je joue sur le lien entre les séries et la zone du graphique.

Quant à l'erreur 91, elle se produit sur le recordset rec2 ligne 200. Je vais voir le soucis qu'il y a là-bas...

En tout cas, à bientôt pour un feedback sur ce que j'aurai fait suite à vos conseils :)

Cordialement

PS: je ne parviens pas à modifier le code dans mon post précédent aussi je le met complet ci-après tel qu'il est actuellement (je suis en train d'y travailler et vais probablement le modifier suite à vos suggestions/conseils/remarques/lectures ;)

Code:

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
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Sub qui transfère les tableaux utilisés pour les calculs de PMI dans un workbook Excel
'qui sera sauvé dans le dossier \CalculPMI\ du CD correspondant
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub TransfertExcelDataPMI(ByVal idctrt As Integer)
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim i As Long, j As Long, n As Long, r As Long
    Dim t0 As Long, t1 As Long
    Dim intReponse As Integer
 
    Dim oDb As DAO.Database
    Dim oDbExcel As DAO.Database
    Dim oTbl As DAO.TableDef
    Dim rec As DAO.Recordset
    Dim rec2 As DAO.Recordset
    Dim rec3 As DAO.Recordset
    Dim rec4 As DAO.Recordset
    Dim oRst As DAO.Recordset
    Dim Chemin As String, txt As String, stSQL As String, a As String
    Dim strChemin As String
    Dim sFichierExcel As String
    Dim sql As String, sql2 As String
 
    Dim bIsNull As Boolean
    Dim vValue As Variant
 
    Dim bFichierExiste As Boolean
 
    ' Gestion des erreurs
    On Error GoTo Catch01
 
    t0 = GetTickCount
    n = 0 'nbr de table exportées
    r = 0 'nbr d'enregistrements total exportés
    Chemin = ""
    strChemin = CurrentProject.Path
    sFichierExcel = strChemin & "\seed_graph2.xlsx"
 
    Set oDb = CurrentDb
    'Ouvre un recordset sur la table DataCollect pour le numéro de CD en cours
    sql = "SELECT * from DataCollect WHERE NumCD = " & idctrt
    Set oRst = oDb.OpenRecordset(sql, dbOpenDynaset)
    oRst.MoveLast
    oRst.MoveFirst
 
    DoCmd.Hourglass True
 
    'Initialisations
    On Error Resume Next ' instruction pour ignorer l'erreur qui pourrait se déclencher sur la ligne suivante
    Set xlApp = GetObject(, "Excel.Application") ' on récupère l'instance Excel ouverte : si pas d'instance la variable est à nothing
    On Error GoTo Catch01 ' reprend la gestion d'erreur normale en annulant l'effet de l'instruction On error resume next
    If xlApp Is Nothing Then ' si pas d'instance d'Excel de créée
        Set xlApp = CreateObject("Excel.Application") ' on crée une nouvelle instance
    End If
 
    'on teste si le fichier seed_graph existe et s'il est disponible = pas ouvert déjà
    bFichierExiste = False
    If Len(Dir(sFichierExcel, vbNormal)) > 0 Then
       bFichierExiste = True
       ' Si fichier ouvert, afficher un message et sortir
       If IsFileOpen(sFichierExcel) Then
          MsgBox "Veuillez fermer le fichier '" & sFichierExcel & "'  SVP"
          Exit Sub
       End If
    End If
 
    If bFichierExiste Then    ' Si le fichier existe on l'ouvre
        Set xlBook = xlApp.Workbooks.Open(sFichierExcel)
    Else    ' Sinon on le crée et on aura un fichier sans feuille avec graphique
        Set xlBook = xlApp.Workbooks.ADD
    End If
 
    ' définir ici le chemin vers le dossier sur le réseau et remplacer Application.CurrentProject.Path par le chemin choisi au début
    'si pas de chemin choisi dans la table DataCollect, demander à le définir et sauver cela dans le champ adéquat "LinkRapport" de la table "DataCollect
    If Len(Trim(oRst.Fields("LinkRapport"))) > 0 Or Not IsNull(oRst.Fields("LinkRapport")) Then   'on vérifie que le champ contient quelque chose
        Chemin = Trim(Replace(oRst.Fields("LinkRapport"), "#", "")) & "\CalculPMI"
        If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin  'est-ce que le chemin existe (jusqu'au dossier CalculPMI)?non? alors on le crèe
 
    Else    'le oRst.Fields("LinkRapport") est donc vide ou null
        'on doit récupérer ici le chemin a parcourir pour y créer le dossier CalculPMI
        Chemin = OuvrirUnFichier(Application.hWndAccessApp, "Sélectionner le dossier du cas contenant les infos ", 1)
            ' si la boite renvoie une adresse non nulle
            If Len(Chemin) > 0 Then
                i = InStrRev(Chemin, Chr(92), , vbTextCompare)
                'MsgBox Mid(Chemin, 1, i - 1)
                oRst.Edit
                oRst.Fields("LinkRapport").value = Mid(Chemin, 1, i - 1)
                oRst.Update
                Chemin = Mid(Chemin, 1, i - 1)
            End If
        Chemin = Chemin & "\CalculPMI"
        MkDir Chemin                        'on peut maintenant créer le chemin et le dossier de destination
    End If
 
    Chemin = Chemin & "\CD" & CStr(idctrt) & "-PMI-" & Format(Now, "dd_mm_yyyy") & ".xlsx"  'on prépare le string contenant le chemin complet avec le nom du fichier qu'on va créer
 
    If Dir(Chemin) <> "" Then
        intReponse = MsgBox("Le fichier " & Chemin & " existe déjà, à l'emplacement spécifié. Désirez-vous le remplacer?", vbYesNoCancel + vbCritical + vbDefaultButton3, "Attention !")
        Select Case intReponse
            Case vbNo
                'DoCmd.Close acForm, "ExportCDExcell"
                MsgBox "L'exportation des données a été annulée", vbCritical, "Attention !"
                GoTo onquitte
            Case vbCancel
                'DoCmd.Close acForm, "ExportCDExcell"
                MsgBox "L'exportation des données a été annulée", vbCritical, "Attention !"
                GoTo onquitte
            Case Else 'on continue le déroulement normal = vbYes
                Kill Chemin  'on supprime le fichier existant
                xlBook.SaveAs (Chemin)   'et on en crèe un nouveau avec le même nom
        End Select
        intReponse = 0
    Else
        xlBook.SaveAs (Chemin)    ' create the workbook '
    End If
 
 
    For Each oTbl In oDb.TableDefs
        If oTbl.Name Like "Temp*" Then
 
            Set rec = oDb.OpenRecordset(oTbl.Name, dbOpenSnapshot)
            rec.MoveLast
            rec.MoveFirst
 
             'Ajouter une feuille de calcul
             Set xlSheet = xlBook.Worksheets.ADD
             xlSheet.Name = Right(CStr(oTbl.Name), Len(oTbl.Name) - 5)  'on garde que les caractères après Tempx pour nommer les feuilles de calculs
 
             ' le titre
             ' écriture dans la cellule de ligne 1 et de colonne 1
             xlSheet.Cells(1, 1) = "Export de la table Access " & oTbl.Name & " concernant le CD" & idctrt
             ' on inscrit sur la ligne 2 les paramètres retenus pour l'ensemble des calculs
             Select Case intdrpb_interpol
                Case 0
                   a = "Lagrange"
                Case 1
                   a = "linéaire"
                Case 2
                   a = "spline"
                Case 3
                   a = "cubic-splines"
                Case Else
                   a = "?"
             End Select
             xlSheet.Cells(2, 1) = "Méthode d'interpolation choisie: " & a
             xlSheet.Cells(2, 5) = "La date d'émergence utilisée est celle où l'on a un total de " & CStr(startnbremerge) & " individu(s) émergé(s) depuis le début (pour chaque espèce)"
 
             ' les entetes des champs sont sur la ligne 3
             '  .Fields(Index).Name renvoie le nom du champ
             For j = 0 To rec.Fields.count - 1
                 xlSheet.Cells(3, j + 1) = rec.Fields(j).Name
                 ' Nous appliquons des enrichissements de format aux cellules
                 With xlSheet.Cells(3, j + 1)
                     .Interior.ColorIndex = 15
                     .Interior.Pattern = xlSolid
                     .Borders(xlEdgeBottom).LineStyle = xlContinuous
                     .Borders(xlEdgeBottom).weight = xlThin
                     .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
                     .HorizontalAlignment = xlCenter
                 End With
             Next j
 
            ' recopie des données à partir de la ligne 4
            i = 4
            r = 0
            Do While Not rec.EOF
            r = r + 1 'compteur enregistrements totaux exportés
 
                For j = 0 To rec.Fields.count - 1
                    ' si on est dans le champ station_number, on va chercher le code de la station pour la traduire en mots utilisables
                    If rec.Fields(j).Name = "station_number" And Not IsNull(rec.Fields(j)) Then
                        xlSheet.Cells(1, 6) = "Station (" & rec.Fields(j) & ") = " & DLookup("Nom", "tblStations_Météo", "Code = " & rec.Fields(j))
                    End If
                    ' .Fields(Index).Type renvoie le type du champ
                    '   si c'est un Texte (dbText) nous insérons "'" pour
                    '   qu'il soit reconnu par Excel comme du Texte
                    Select Case rec.Fields(j).type
                    Case dbText
                        xlSheet.Cells(i, j + 1) = Chr(39) & rec.Fields(j)
                    Case dbDate
                        xlSheet.Cells(i, j + 1) = DateSerial(Year(rec.Fields(j)), Month(rec.Fields(j)), Day(rec.Fields(j))) + TimeSerial(Hour(rec.Fields(j)), 0, 0)  ' Format(rec.Fields(j).value, "dd/mm/yyyy hh:nn:ss")
                    Case Else
                        xlSheet.Cells(i, j + 1) = rec.Fields(j)
                    End Select
                Next j
                i = i + 1
                rec.MoveNext
            Loop
            n = n + 1 'compteur nbr tables totales exportées
        Else
            GoTo LastLine
        End If
        rec.Close
LastLine:
    Next oTbl
 
    sql = ""
' si bFichierExiste= true, on va maintenant exporter dans la feuille graphique du fichier xlsx généré
' les colonnes adéquates pour alimenter le graphique existant
' en fait c'est la table Temp6StationExtrap à laquelle on a retiré certains champs
    sql2 = "SELECT * from Temp6StationExtrap"
    Set rec2 = oDb.OpenRecordset(sql2, dbOpenDynaset)
    rec2.MoveLast
    rec2.MoveFirst
 
    'chaine sql qui reprendra uniquement les champs nécessaire de la table ' on essaie en enlevant les Temp6StationExtrap. devant les noms des champs
    sql = "SELECT [DateFull], " & _
    "[relative_humidity_under_shelter], " & _
    "[precipitation_duration], " & _
    "[precipitation_quantity], " & _
    "[" & rec2.Fields(6).Name & "], " & _
    "[TempExtrapTE], "
    'on y rajoute les champs correspondants aux espèces présentes, concaténés l'un après l'autre,
    'ca commence à partir de la colonne n°11 de la table d'origine
    For j = 11 To rec2.Fields.count - 1
        sql = sql & "[" & Trim(rec2.Fields(j).Name) & "], "
    Next j
    'et on fini la chaine
    sql = Left(sql, Len(sql) - 2) & " FROM Temp6StationExtrap"
    'on ferme ce recordset pour pouvoir réutiliser la variable
 
    'ouverture du recordset avec juste les champs retenus
    Set rec3 = oDb.OpenRecordset(sql, dbOpenDynaset)
    rec3.MoveLast
    rec3.MoveFirst
    'dans le rec, pour chaque espèce, on va garder la première et la dernière valeur non nulle
    'ca servira a illustrer les espèces sur le graphe
    'le premier champs correspondant à une espèce commence à la colonne 7 (= fields(6))
    For j = 6 To rec3.Fields.count - 1
        bIsNull = True
        vValue = Null
        With rec3
            Do While Not .EOF
                If IsNull(.Fields(j)) Then      '--- actuel Null
                    bIsNull = True
                    If IsNull(vValue) Then
                        '--- continuer (rien à changer)
                    Else
                        '--- remettre valeur sur enregistrement précédent
                        '--- (Nullé alors qu'il n'aurait pas du l'être)
                        .MovePrevious
                        .Edit
                        .Fields(j).value = 30   'ou vValue si on garde la valeur d'origine
                        .Update
                        '--- revenir sur enregistrement en cours
                        vValue = Null
                        .MoveNext
                    End If
                Else                            '--- actuel non Null
                    If bIsNull Then                 '--- champ précédent vide
                        bIsNull = False
                        '--- et continuer (rien à changer)
                        .Edit
                        .Fields(j).value = 30   ' ou vValue si on garde la valeur d'origine
                        .Update
                    Else                            '--- champ précédent non vide
                        vValue = 30 'ou .Fields(j).value si on garde la valeur d'origine
                        .Edit
                        .Fields(j).value = Null
                        .Update
                    End If
                End If
                .MoveNext
            Loop
        End With
    rec3.MoveFirst
    Next j
 
    'on sauve et ferme le classeur excel
    xlBook.Close True  ' sauve et ferme le workbook
 
    If TestExistenceFeuille("graphique", Chemin, xlApp) Then
        'on continue
        Set xlBook = xlApp.Workbooks.Open(Chemin)   'on réouvre le workbook
        Set xlSheet = xlBook.Sheets("graphique")    'on sélectionne la feuille
    Else
        MsgBox "La feuille n'existe pas"
        GoTo quitpourtest
    End If
 
    ' les entetes des champs sont sur la ligne 3
    For j = 0 To rec3.Fields.count - 1
        xlSheet.Cells(3, j + 1).value = rec3.Fields(j).Name
        ' Nous appliquons des enrichissements de format aux cellules
        With xlSheet.Cells(3, j + 1)
            .Interior.ColorIndex = 15
            '.Font.Bold = True
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next j
 
    xlSheet.Cells(4, 1).CopyFromRecordset rec3 ' copie du recordset à partir de la cellule (4,1)= "A4" de la feuille
    rec3.Close
 
quitpourtest:
    xlBook.Close True  ' sauve le workbook    xlBook.Save  ' sauve le workbook
    xlApp.Quit
 
    DoEvents
 
onquitte:
    DoCmd.Hourglass False
 
Set rec = Nothing
rec2.Close
Set rec2 = Nothing
Set rec3 = Nothing
Set rec4 = Nothing
 
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
 
MsgBox "Les données ont été sauvées dans le fichier : " & Chemin
 
Set oTbl = Nothing
Set oDbExcel = Nothing
Set oDb = Nothing
 
''    MonRubanEntomo.ActivateTab "NewDossier"
    'Stop_Timer (1)
Exit Sub
 
 
Catch01:
Select Case err.Number
    Case 0
        GoTo onquitte
    Case 2220
        'Cas d'un emplacement non valide du fichier
        MsgBox "Le fichier n'a pas été trouvé à l'emplacement indiqué : " & vbCrLf & _
                Chemin, vbCritical + vbOKOnly, "Export Excel"
        Exit Sub
    Case Else
        ' tout autre cas d'erreur
        MsgBox "Erreur inattendue : " & err.Number & vbCrLf & err.Description, vbCritical + vbOKOnly, "Export Excel"
End Select
err.Clear
GoTo onquitte
 
End Sub

13/10/2020, 13h24
Dermochelys

Bonjour User, tee_grandbois,

Grâce a votre aide j'ai résolu mes soucis :)
L'erreur 91 était causée par un recordset mal nommé.

Par ailleurs, la copy du recordset (rec3) dans la feuille cible ne se faisait pas tout simplement parce que j'étais à la fin de celui-ci ... honte à moi :oops: ET avant de travailler sur la feuille cible, j'ai préféré sauver le classeur puis le réouvrir. En effet, comme il est possible qu'il n'y ai pas de feuille cible, il fallait tester cela.

Du coup, j'ai modifier le code du post précédent par le code définitif qui fonctionne pour illustrer ce que j'ai fait. Le code est encore perfectible (surtout pour l'alléger) mais ça fonctionne :)

Un grand merci pour votre aide qui me permet de passer à d'autres étapes :D