Bonjour,
Je souhaite utiliser le code écrit par LedZeppII http://www.developpez.net/forums/d92...ss-vers-excel/ concernant l'exportation de données Access vers Excel et créant des onglets.
J'ai recopié le code mais j'obtiens une erreur 50290 : "Erreur définie par l'application ou par l'objet"
Le problème se pose à la ligne 28. Que Excel soit ouvert ou non, que j'ai défini ou non un chemin et un nom de fichier entre les parenthèses...
Je n'ai rien changé à l'exception de la requête ligne 14. La référence "Microsoft EXcel14 Object library est cochée...
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Sub ExpCmdesParClient() Dim xlApp As Excel.Application, xlAppCreated As Boolean Dim xlWbk As Excel.Workbook, xlSht As Excel.Worksheet Dim NumFeuille As Integer, NumCol As Long Dim db As DAO.Database, qdf As DAO.QueryDef Dim rsCli As DAO.Recordset, rsData As DAO.Recordset On Error GoTo ErrH Set db = CurrentDb ' Ouvre la requête ne sélectionnant que des "code client" distincts. ' Comme j'en ai beaucoup, je ne prends que les 10 premiers Set rsCli = db.OpenRecordset("SELECT TOP 10 [Code Client] FROM qryClientsDansCommandes") If rsCli.EOF Then GoTo ExitSub ' requête paramétrée Set qdf = db.QueryDefs("qryCommandesClient_prmClient") ' Tente de récupérer une instance d'Excel déjà créée Set xlApp = GetObject(, "Excel.Application") ' Sinon, crée une nouvelle instance d'Excel If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application") xlAppCreated = True End If ' Crée un nouveau Classeur Set xlWbk = xlApp.Workbooks.Add() ' Boucle sur les clients Do While Not rsCli.EOF ' Pour chaque Client NumFeuille = rsCli.AbsolutePosition + 1 ' Sélectionne ou crée une nouvelle feuille If NumFeuille <= xlWbk.Worksheets.Count Then Set xlSht = xlWbk.Worksheets(NumFeuille) Else Set xlSht = xlWbk.Worksheets.Add(, xlSht) End If ' renomme la feuille (onglet) xlSht.Name = rsCli("Code client") ' Fournit le paramètre à la requête paramétrée qdf.Parameters("prmCodeClient") = rsCli("Code Client") ' Obtient les données en exécutant la requête paramétrée Set rsData = qdf.OpenRecordset(dbOpenSnapshot) ' Ligne 1 : en-têtes de colonnes For NumCol = 1 To rsData.Fields.Count xlSht.Cells(1, NumCol) = rsData.Fields(NumCol - 1).Name Next ' Ligne 2 : Données xlSht.Range("A2").CopyFromRecordset rsData xlSht.Columns.AutoFit ' Client suivant rsCli.MoveNext Loop ' Sélectionne 1ère feuille avant de sauver xlWbk.Worksheets(1).Activate ' Pour confirmer l'écrasement du Classeur s'il existe xlApp.DisplayAlerts = False ' Sauvegarde du Classeur xlWbk.SaveAs CurrentProject.Path & "\Test.xls" ' Fermeture du Classeur xlWbk.Close False ExitSub: ' Réactive les messages d'avertissement xlApp.DisplayAlerts = True ' Libération des variables objets Set rsData = Nothing Set rsCli = Nothing Set db = Nothing Set xlSht = Nothing Set xlWbk = Nothing If xlAppCreated = True And Not (xlApp Is Nothing) Then xlApp.Quit Set xlApp = Nothing Exit Sub ErrH: Select Case Err.Number Case 429 ' Ignorer Erreur causée par GetObject(, "Excel.Application") Resume Next Case Else MsgBox "Erreur N. " & Err.Number & " : " & Err.Description Resume ExitSub End Select End Sub A+
Merci m'aider à comprendre et corriger ...
Xorbane
Partager