[AC-2003] Problème exportation requête access vers tableau excel [Résolu]

[demichoux]

Bonjour,

J'ai un code vba qui me permet d'exporter une requête de ma base access vers un tableau excel, lorsque je fais mon exportation je ne paut pas ouvrir mon classseur excel directement il faut que j'ouvre le gestionnaire des taches, que je clic sur l'onglets processus et et que j'arret le processus excel c'est ch***t quand j'ai plusieurs tableau excel car ça les ferme tous quelqu'un aurait-il une solution a mon problème SVP

Ci-dessous le code VBA

Code VBA :

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
Private Sub Commande48_Click()
  ' déclaration des variables
    Dim Planning As Workbook
    Dim ok As String
    Dim StructFile As OPENFILENAME
    Dim sFiltre As String
   Dim tabListe() As String             ' tableau où on va stocker la liste des requête
   Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
   Dim xlBook As Excel.Workbook         ' le classeur où se trouve la feuille
   Dim xlSheet As Excel.Worksheet       ' la feuille où on va stocker les tables
   Dim db As DAO.Database              ' nous utilisons la bibilothèque DAO
   Dim rec As DAO.Recordset             ' le recordset pour récupérer les données des tables
   Dim I As Integer                     ' pour boucler sur les tables
   Dim j As Integer
'   Dim ok As String
 
ok = MsgBox("Voulez-vous exporter les données vers un tableau excel ?" _
 & vbCrLf & vbCrLf & "Si vous cliquez sur Oui une boite de dialogue vas s'ouvrir", "" _
 & vbYesNo + vbQuestion, "Exportation de données")
 
'    Retour a la ligne "1 ére Ligne"& vbCrLf &"2 éme Ligne"
 
If ok = vbYes Then
 
' Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Rechercher Fichier Model Tableau Excel (*.xls)" & Chr$(0) & "*.*" & Chr$(0)
 
 
' Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) 'Initialisation de la grosseur de la structure
    .hwndOwner = Handle 'Identification du handle de la fenêtre
    .lpstrFilter = sFiltre 'Application du filtre
    .lpstrFile = String$(254, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 254 'Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  'Taille maximale du nom du fichier
    .lpstrTitle = Titre 'Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
 
  End With
 
    If GetOpenFileName(StructFile) Then
 
 
            Set Planning = Excel.Workbooks.Open(Filename:=StructFile.lpstrFile)
 
   Set db = CurrentDb
 
'   ' on rempli le tableau avec 1 requête
   ReDim tabListe(1)
'
    tabListe(0) = "Focus sur RN"
'
'
'
'   ' bouclage sur les tables pour remplir la feuille
   For I = 0 To UBound(tabListe()) - 1
 
 
 
            Set rec = CurrentDb.OpenRecordset(tabListe(I), dbOpenSnapshot)
 
            Planning.Sheets("Focus sur RN").Range("A2").Offset(1, 0).CopyFromRecordset rec
 
 
        Set rec = Nothing
   Next I
 
    MsgBox "Fin de traitement -  votre fichier Excel a été enregistré "
 
   Planning.SaveAs "X:\Projets\SCI\Management du projet\Gestion de configuration\050_EchangeMPH\110 - Données Fournisseurs\Données de sortie\Export Suivi fournisseurs" & Format(Date, "yy", vbUseSystemDayOfWeek) & Format(Date, "mm", vbUseSystemDayOfWeek) & Format(Date, "dd", vbUseSystemDayOfWeek) & ".xls"
    End If
 End If
 End Sub

[User]

Bonjour,

Attention à bien ouvrir et libérer de manière classique les objets Excel :

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
Dim xlBook As Excel.Workbook         ' le classeur où se trouve la feuille
Dim Planning As Excel.Workbook
Dim xlSheet As Excel.Worksheet
 
 
Set xlApp = New Excel.Application
...
Set Planning = xlApp.Workbooks.Open(Filename:=StructFile.lpstrFile)
 
...

A+

[demichoux]

Bonjour User,


Merci donc j'ai fait les modifications, mais mon problème persiste, je n'arrive toujours pas a ouvrir le classeur directement aprés l'exportation.


@+

[Godzestla]

Bonjour Demichoux,
il serait bon que tu montres ton code modfié selon les conseils judicieux de user.

[User]

ReBonjour,

Une solution en 2 étapes serait de :

I)
piloter et mettre à jour ton classeur Excel au moyen de variables, puis libérer ces variables en fin de mise à jour,

II)
Et enfin ouvrir ton classeur au moyen de la fonction ShellExecute.

Pour ce faire je peux te donner 1 exemple:

Il te faut déjà déclarer la fonction shellExecute dans 1 module indépendant au début du module, dans la partie déclarative:

Code :

1
2
3
Option Compare Database
 
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Puis le code exemple sur clic d'1 bouton de commande dans un formulaire :

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
Private Sub Commande1_Click()
Dim xlApp As Excel.Application       ' ne pas oublier de cocher la référence Excel
Dim xlPlanning As Excel.Workbook
Dim xlSheet As Excel.Worksheet
 
Set xlApp = New Excel.Application ' ouverture
 
Set xlPlanning = xlApp.Workbooks.Open("c:\Planning\Planning.xls")
 
Set xlSheet = xlPlanning.Worksheets(1)
 
xlSheet.Cells(1, 1) = "je suis dans la ligne1 et colonne1"
 
xlPlanning.Save 'Sauvegarde du classeur
xlApp.Quit
 
Set xlSheet = Nothing ' Libération des variables
Set xlPlanning = Nothing
Set xlApp = Nothing
 
' ouverture du classeur
 
ShellExecute Me.hWnd, "open", "c:\Planning\Planning.xls", "", CurrentProject.Path, 1
 
End Sub

Tu dois t'en inspirer

A+

[demichoux]

Merci user je me suis inspirer de se que tu m'as donner et ça fonctione je peut ouvrir mon fichier directement après l'exportation

Encore Merci

@+