Discussion :

[Uriel_Parlevent]

Bonjour, je tiens à préciser que j'ai lu la FAQ, fais des recherches ect ... J'utilise le forum car malgré tout, je ne parviens pas à résoudre mon problème.
J'essaye de coder un bouton pour importer le résultat d'une requête vers Excel, voici mon code :

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
Public Sub Commande18_Click()
Dim Appxls As Excel.Application
Dim Wbk As Excel.Workbook
Dim Sht As Excel.Worksheet
Dim qd As QueryDef
 
Set Appxls = CreateObject("Excel.Application")
Set Wbk = Appxls.Workbooks.Open("C:\Users\lenezet\Documents\Testfichier.xls")
Set Sht = Wbk.Sheets("Feuil1")
Appxls.Visible = True
Call definirfour
MsgBox (NOM_FOUR_VARIABLE) 'ça fonctionne
If TestExistenceFeuille(NOM_FOUR_VARIABLE, "C:\Users\lenezet\Documents\Testfichier.xls", Appxls) Then
MsgBox "La feuille existe déjà"
Set Wbk = Appxls.Workbooks.Open("C:\Users\lenezet\Documents\Testfichier.xls")
Set Sht = Wbk.Sheets(NOM_FOUR_VARIABLE)
Appxls.Visible = True
DoCmd.TransferSpreadsheet acExport, 8, "R_controle_a_faire", "C:\Users\lenezet\Documents\Testfichier.xls", True 'le problème survient ici
 
'ouvrir le fichier
'ouvrir la bonne feuille
'importer dans la feuille
Else
MsgBox "La feuille n'existe pas"
Set Wbk = Appxls.Workbooks.Open("C:\Users\lenezet\Documents\Testfichier.xls")
Set Sht = Wbk.Sheets("Feuil1")
Set Sht = Wbk.Sheets.Add(after:=Sheets(Sheets.Count))
Sht.Name = NOM_FOUR_VARIABLE
'ouvrir le fichier
'créer une nouvelle feuille avec le bon nom
'importer dans la feuille
End If
 
End Sub

Au niveau de "DoCmd.TransferSpreadsheet acExport, 8, "R_controle_a_faire", "C:\Users\lenezet\Documents\Testfichier.xls", True" il y a une erreur d'exécution me disant qu'Access n'arrive pas à retrouver l'objet R_controle_a_faire (la requête sélection que je veux importer). Cette requête existe pourtant bel et bien, rien d'autre n'a le même nom.
Je suis perplexe.

[Uriel_Parlevent]

(Je ne peux pas Edit : "La page web ne peut pas s'afficher")

J'ai modifié la ligne par

Code :

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

DoCmd.TransferSpreadsheet acExport, 8, "R_controle_a_faire", "C:\Users\lenezet\Documents\Testfichier.xls", True, NOM_FOUR_VARIABLE

Cela ne fonctionne toujours pas, mais si je fermes manuellement le fichier Excel et que je fais continuer (suite au débogage), la sub se termine normalement.
Malheureusement, quand j'ouvre le fichier, j'ai la feuille avec NomduFournisseur qui est vide et une feuille NomduFournisseur1 qui se créer et qui contient l'export.

[Zekraoui_Jakani]

Peux-tu mettre copie de ta DB, avec données fictives, à notre disop ? ça facilitera l'analyse

[Uriel_Parlevent]

J'espère que c'est bien ça que vous voulez, j'utilise déjà des données fictives, n'y cherchez aucun sens.

Prototype avancé - Copie.zip

Edit : il y a des boutons qui ne sont pas fonctionnels et des subs dont je ne me sers pas (je les gardent pour avoir des "notes")

Edit2 : j'ai réussi à le faire fonctionner une fois, mais je ne comprend pas comment. Ça doit être une histoire de fermeture/sauvegarde du fichier Excel

Edit3 : Quant bien même je me contenterai d'avoir le nom du fournisseur avec un 1 à la fin, un nouvel import dans une même feuille efface le précédent ...

[Uriel_Parlevent]

Vu que personne ne semble savoir, je vais procéder d'une façon différente.

Je vais importer avec un

Code :

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

appexcel.cells(x, y) = rst![Nomduchamp]

Ça risque d'être lourd car je vais devoir importer les champs un par un (et les compter ainsi que les "non-vide" du fichier Excel) mais au moins, ça sera un solide pas à pas

Je partagerai mon code quand j'aurai fini, j'ai vu sur internet que d'autres avaient déjà eu ce genre de problèmes, la solution "rustine" pourrait donc faire gagner du temps à plus d'un

[Uriel_Parlevent]

Nous y voilà, méthode rustine qui contrecarre toutes les erreurs possibles et imaginables

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
 
Option Compare Database
Option Explicit
Public NOM_FOUR_VARIABLE As String
Public Variable_PN As String
Public nbcell As Long
--------------------------------------------------------------
Private Sub Commande0_Click()
Call definirfour
Call SelectColonePN
nbcell = 0
End Sub
-------------------------------------------------------------
Public Sub definirfour()
Dim SQL_CODE As String
Dim db As DAO.Database, rs1 As DAO.Recordset, fld As DAO.Field
 
Set db = CurrentDb
 
SQL_CODE = _
" SELECT [Nom Fournisseur] As Nom_Fournisseur FROM [R_Controle_a_faire]"
Set rs1 = db.openrecordset(SQL_CODE)
NOM_FOUR_VARIABLE = " "
 
Do While Not rs1.EOF
NOM_FOUR_VARIABLE = rs1![Nom_fournisseur]
rs1.MoveNext
Loop
 
If NOM_FOUR_VARIABLE = " " Then
'C'est pas le beau jeu
MsgBox "Nom du fournisseur absent"
End If
End Sub
---------------------------------------------------------------------------------------------------
Public Sub SelectColonePN()
Dim SQL_CODE As String
Dim db As DAO.Database, rs1 As DAO.Recordset, fld As DAO.Field
 
Call definirfour
Set db = CurrentDb
 
SQL_CODE = _
" SELECT [P/N] As P_N From [R_Controle_a_faire]"
Set rs1 = db.openrecordset(SQL_CODE)
Variable_PN = " "
 
Do While Not rs1.EOF
Variable_PN = rs1![P_N]
MsgBox (Variable_PN)
'importation
Call Importer_PN
rs1.MoveNext
Loop
 
If Variable_PN = " " Then
MsgBox "PN absent"
End If
 
End Sub
--------------------------------------------------------------------------------------------------------------------
Public Sub Importer_PN()
Dim appexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim Sht As Excel.Worksheet
Set appexcel = CreateObject("Excel.Application")
appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("C:\Users\lenezet\Documents\Testfichier.xls")
Set Sht = wbexcel.Sheets(NOM_FOUR_VARIABLE)
If nbcell = 0 Then
nbcell = Sht.Application.WorksheetFunction.CountA(Sht.Range("A:A"))
End If
nbcell = nbcell + 1
appexcel.Cells(nbcell, 1).Value = Variable_PN
wbexcel.Save
wbexcel.Close
appexcel.Quit
Set wbexcel = Nothing
Set appexcel = Nothing
Set Sht = Nothing
End Sub

Alors oui, c'est extrêmement moche et probablement très mal optimisé, mais ça a le mérite de faire ce que je veux.
C'est à dire importer dans Excel la première colonne, ici la colone PN (il faut que je fasse la même fonction pour chaque colonne de ma requête que je veux importer) de ma requête "R_Controle_a_faire".
J'ai fait en sorte que l'import se fasse dans la colonne 1 (la A) de la feuille : "NOM_FOUR_VARIABLE" du fichier Excel et qu'il n'efface pas les enregistrements précédents (d'où le recours à un tel nombre de variables globales).
J'espère que ça pourra dépanner des gens qui ont le même problème que moi.

Edit, celui là est un peu mieux, on ouvre/ferme le ficher Excel seulement une fois :

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
Public Sub ToutImport()
Dim SQL_CODE As String
Dim db As DAO.Database, rs1 As DAO.Recordset, fld As DAO.Field
Dim appexcel As Excel.Application
Dim wbexcel As Excel.Workbook
Dim Sht As Excel.Worksheet
 
Set appexcel = CreateObject("Excel.Application")
appexcel.Visible = True
Set wbexcel = appexcel.Workbooks.Open("C:\Users\lenezet\Documents\Testfichier.xls")
Set Sht = wbexcel.Sheets(NOM_FOUR_VARIABLE)
Set db = CurrentDb
 
SQL_CODE = _
" SELECT [P/N] As P_N From [R_Controle_a_faire]"
Set rs1 = db.openrecordset(SQL_CODE)
Variable_PN = " "
 
Do While Not rs1.EOF
Variable_PN = rs1![P_N]
'MsgBox (Variable_PN)
'importation
If nbcell = 0 Then
nbcell = Sht.Application.WorksheetFunction.CountA(Sht.Range("A:A"))
End If
nbcell = nbcell + 1
appexcel.Cells(nbcell, 1).Value = Variable_PN
rs1.MoveNext
Loop
 
If Variable_PN = " " Then
MsgBox "PN absent"
End If
rs1.Close
nbcell = 0
wbexcel.Save
wbexcel.Close
appexcel.Quit
Set wbexcel = Nothing
Set appexcel = Nothing
Set Sht = Nothing
End Sub