Discussion :

[jrogron]

Bonjour,

Mon formulaire recherche (réalisé à l'aide du tuto de caféine) possède une fonction qui permet d'exporter ma liste de résultat vers un tableau excel.
Une fois que j'ai fais une demande d'exportation (clic sur un bouton de commande) il m'ouvre mon tableau excel avec les infos mais si je ne ferme pas se tableau et que je réalise un second clic alors là c'est la m****. Une erreur s'affiche et tout est planté. Je ne peut même plus faire fonctionner l'appli par la suite.

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
Private Sub Commande42_Click()
Dim fso As FileSystemObject
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FolderExists("c:\Recherche formulaire") Then
Else
 fso.CreateFolder ("c:\Recherche formulaire")
End If
 
Dim SQL As String
SQL = Me!lstResults.RowSource
CurrentDb.CreateQueryDef "results", SQL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "results", "C:\Recherche formulaire\results"
DoCmd.DeleteObject acQuery, "results"
 
Dim Xl As Excel.Application
Dim Classeur As Excel.Workbook
Set Xl = New Excel.Application
Xl.Visible = True
Set Classeur = Xl.Workbooks.Open("C:\Recherche formulaire\results.xls")
End Sub

Qui aurait une idée de comment éviter se bug?

Merci,

Jocelyn

[pgz]

Bonjour,

Voici une idée de code qui colle le plus possible à ton code initial. Attention, il n'est pas testé et reste donc à débuguer. Il remplace simplement des explications fastidieuses. C'est juste pour les idées...

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
Private Sub Commande42_Click()
Dim fso As FileSystemObject, db As DAO.Database, SQL As String, wbk As Excel.Workbook
Const strRep As String = "C:\Recherche formulaire", strFichier As String = strRep & "\results.xls"
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
'création du répertoire s'il n'existe pas
If Not fso.FolderExists(strRep) Then fso.CreateFolder (strRep)
 
'supprimer classeur xl s'il existe( il peut être ouvert)
On Error Resume Next
Set wbk = GetObject(strFichier)
If Err.Number = 0 Then
    wbk.Close False ' il existe et maintenant est ouvert
    DoEvents
    Kill strFichier
    DoEvents
Else
    Err.Clear ' il n'existe pas
End If
On Error GoTo 0
 
SQL = Me!lstResults.RowSource
Set db = CurrentDb
db.CreateQueryDef "results", SQL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "results", strFichier
DoCmd.DeleteObject acQuery, "results"
 
Set wbk = GetObject(strFichier)
wbk.Application.Visible = True
 
Set wbk = Nothing
Set db = Nothing
End Sub

En espérant que cela t'aide et cordialement,

pgz

[jrogron]

Bonjour,

J'ai fais quelque modifs:

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
Private Sub Commande42_Click()
Dim fso As FileSystemObject, db As DAO.Database, SQL As String, wbk As Excel.Workbook, Xl As Excel.Application
Const strRep As String = "C:\Recherche formulaire", strFichier As String = strRep & "\results.xls"
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
'création du répertoire s'il n'existe pas
If Not fso.FolderExists(strRep) Then fso.CreateFolder (strRep)
 
'supprimer classeur xl s'il existe( il peut être ouvert)
On Error Resume Next
Set wbk = Xl.Workbooks.Open(strFichier)
If Err.Number = 0 Then
    wbk.Close False ' il existe et maintenant est ouvert
    DoEvents
    Kill (strFichier)
    DoEvents
Else
    Err.Clear ' il n'existe pas
End If
On Error GoTo 0
 
SQL = Me!lstResults.RowSource
Set db = CurrentDb
db.CreateQueryDef "results", SQL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "results", strFichier
DoCmd.DeleteObject acQuery, "results"
 
Set Xl = New Excel.Application
Xl.Visible = True
Set wbk = Xl.Workbooks.Open(strFichier)
 
Set wbk = Nothing
Set db = Nothing
End Sub

Mon erreur quand je refais exporter alors que ma fenêtre excel n'a pas été fermé précédement est la suivante:
"La table result existe déjà"

Et le curseur s'arrête sur la ligne de code suivante:

Code :

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

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "results", strFichier

Je ne comprends pas j'ai l'impression qu'il ne prend pas en compte les ligne de code concernant la fermeture de excel si la table est ouverte.

Merci,

Jocelyn

[pgz]

Bonjour,

As-tu essayé le code sans le modifier?

pgz

[jrogron]

Bien entendu pqz. Cela a même été ma première manip.

En faite quand j'utilise ton code cela créé un bien un fichier excel mais il ne s'ouvre pas. De plus quand je vais voir dans le dossier "recherche formulaire" présent sur mon disque c et que j'ouvre le fichier excel alors j'ai un pb car cela s'ouvre tout blanc. En faite excel s'ouvre et se referme aussitot.
Et quand je vais chercher le fichier pour l'ouvrir alors la fenêtre est transparente (je sais cela doit te sembler imcompréensible).

Je ne comprends donc pas d'ou vient l'erreur.

Merci beaucoup pour ton aide pqz,

Jocelyn

[pgz]

Bonjour Jocelyn,

J'ai en effet du mal à voir.
Peut-être avec la base?

A+

pgz

[jrogron]

Bonsoir PGZ!!!

Je me permet de te demander de regarder mon dernier post à cette adresse:

http://www.developpez.net/forums/sho...d.php?t=197073

Je te remercie beaucoup.

Jocelyn

[pgz]

Bonsoir,

Avec ta base, j'ai pu regarder les pb. Comme toi, avec le code que je te proposais, je n'ai pas le classeur visible. PAr contre il se crée correctement et je peux l'ouvrir sans pb.

Après modification, chez moi cela fonctionne très bien. Voici le code après mise au point:

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
Private Sub Commande42_Click()
Dim fso As FileSystemObject, db As DAO.Database, SQL As String, wbk As excel.Workbook
Const strRep As String = "C:\Recherche formulaire", strFichier As String = strRep & "\results.xls"
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
'création du répertoire s'il n'existe pas
If Not fso.FolderExists(strRep) Then fso.CreateFolder (strRep)
 
'supprimer classeur xl s'il existe( il peut être ouvert)
On Error Resume Next
Set wbk = GetObject(strFichier)
If Err.Number = 0 Then ' il existe et maintenant est ouvert
    wbk.Close False
    Kill strFichier
Else ' il n'existe pas
    Err.Clear
End If
On Error GoTo 0
 
SQL = Me!lstResults.RowSource
Set db = CurrentDb
db.CreateQueryDef "results", SQL
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "results", strFichier
DoCmd.DeleteObject acQuery, "results"
 
Set wbk = GetObject(strFichier)
wbk.Application.Visible = True
wbk.Parent.Windows(1).Visible = True
 
Set wbk = Nothing
Set db = Nothing
End Sub

Cordialement,

pgz

[jrogron]

Bonjour PGZ !!!

C'est un peu mieux mais il se passe des choses vraiment très bizarre quand je test ton code sur mon pc. Je ne sais pas pourquoi mais voici se qui se passe:

1- Je clic sur le bouton excel (pour exporter)
2- Une page internet sur le logiciel systran s'ouvre (ça c'est vraiment bizarre )
3- Une fenêtre windows s'ouvre (la fenêtre normal qui dit que windows a récupéré une erreur sérieuse avec la case à cocher en bas pour faire un backup)
4- J'ai une fenêtre excel qui s'ouvre avec les infos voulus et une seconde vide.

Je n'ai pas testé sur un autre pc pour le moment mais je trouve ces problèmes étranges. Je vais essayer de faire une compilation de ton code et de mon ancien code.

Amicalement,

Jocelyn

[pgz]

Bonjour,

Je ne sais pas ce qui se passe chez toi, mais je te garantie que le code fonctionne très bien chez moi, dans ta base.
Je ne sais pas expliquer ce que tu décris!

A+

pgz

[jrogron]

Salut PGZ!!!

En effet je viens de tester sur un autre pc et aucun problème.

C'est vraiment bizarre

Amicalement,

Jocelyn