Discussion :

[Xorbane]

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...

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+

Je n'ai rien changé à l'exception de la requête ligne 14. La référence "Microsoft EXcel14 Object library est cochée...

Merci m'aider à comprendre et corriger ...

Xorbane

[tee_grandbois]

Bonsoir,
Essaie en enlevant les () à l'instruction 28:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set xlWbk = xlApp.Workbooks.Add()

[VincentNguon]

Je rajoute toujours ça avant d"effectuer des actions sur Excel depuis Access.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Excel.Application.DisplayAlerts = False

A tester...

[Xorbane]

Bonsoir,

En fait, j'avais une boite de dialogue excel ouverte derrière mes autres fenêtres. Une fois tout fermé cela a fonctionné sans problème.

Merci,

Xorbane