Bonjour.
J'ai récupéré sur le site la fonction permettant d'utiliser la boite de dialogue standard 'Enregister sous' (voir http://access.developpez.com/faq/?pa...AffBoitEnregSs
Mon problème, il enregistre dans la bonne directorie (que ce soit celle par défaut ou une autre), mais ne prend pas en compte le nom du fichier (que ce soit celui par défaut ou un autre nom tapé dans la boite, il enregistre systématiquement un fichier dont le nom est : 1.xls)
La question : Pourquoi et comment résoudre cela?
Pour info, j'utilise le menu (Merci C.WARIN) - voir http://warin.developpez.com/access/tutorielcontext1/
Ce menu execute une Function dans un module et cette fonction va chercher la Sub de mon form, car l'ouverture de la boite 'enregistrer sous' ne s'effectue que depuis une Sub, pas depuis une Function. Ma Sub est déclarée Public
Voici le code
code qui lance ma Sub de formulaire depuis une Function lancée depuis le Menu
Dans un module: (paramétrage pour utilisation boite enregistrer sous)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 Public Function Export() 'Lance l'execution de pa procédure dans le form 'frmGénéral' _ car la fonction de boite de dialogue ne fonctionne pas depuis une Function, _ mais seulement depuis une Sub Forms!frmGénéral.bteDlgEnr End Function
Dans mon formulaire
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 Option Explicit Option Compare Database 'Déclaration de l API Private Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _ As Long 'Structure du fichier Private Type OPENFILENAME lStructSize As Long hWndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Function EnregistrerUnFichier(Handle As Long, Titre As String, _ NomFichier As String, Chemin As String) As String 'EnregistrerUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _ la boîte de dialogue d'enregistrement d'un fichier. 'Explication des paramètres 'Handle = le handle de la fenêtre (Me.Hwnd) 'Titre = Titre de la boîte de dialogue 'NomFichier = Nom par défaut du fichier à enregistrer 'Chemin = Chemin par défaut du fichier à enregistrer Dim structSave As OPENFILENAME With structSave .lStructSize = Len(structSave) .hWndOwner = Handle .nMaxFile = 255 .lpstrFile = NomFichier & String$(255 - Len(NomFichier), 0) .lpstrInitialDir = Chemin '.lpstrFilter = "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0) 'Définition du filtre (aucun) .lpstrFilter = "Tous (*.xls)" & Chr$(0) & "*.xls" & Chr$(0) 'Définition du filtre (xls - Feuille Excel) .Flags = &H4 'Option de la boite de dialogue End With If (GetSaveFileName(structSave)) Then EnregistrerUnFichier = Mid$(structSave.lpstrFile, 1, InStr(1, structSave.lpstrFile, vbNullChar) - 1) End If End Function
Merci à tous et bon courage à vous
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14.... rqtClients = "SELECT tblClients.N°Client, " & litAff0 & ", " & litAff1 & ", " & litAff2 & ", " & litAff3 & ", " & litAff4 & ", " & litAff5 & ", " & litAff6 & ", " & litAff7 & ", " & litAff8 & ", " & litAff9 & ", " & litAff10 & ", " & litAff11 & ", " & litAff12 & ", " & litAff13 & ", " & litAff14 & ", " & litAff15 & ", " & litAff16 & ", " & litAff17 & _ " FROM ((((((tblClients LEFT JOIN tblTampon ON tblClients.N°Client = tblTampon.N°Client) LEFT JOIN [aa-TxRéussite] ON tblClients.N°Client = [aa-TxRéussite].N°Client) LEFT JOIN [rqtAction-dernierParClient1] ON tblClients.N°Client = [rqtAction-dernierParClient1].N°Client) LEFT JOIN [rqtObjectif-dernierParClient1] ON tblClients.N°Client = [rqtObjectif-dernierParClient1].N°Client) LEFT JOIN [rqtPotentiel-dernierParClient1] ON tblClients.N°Client = [rqtPotentiel-dernierParClient1].N°Client) LEFT JOIN [rqtPotentielSFI-dernierParClient1] ON tblClients.N°Client = [rqtPotentielSFI-dernierParClient1].N°Client) LEFT JOIN [rqtFreqVisites-dernierParClient1] ON tblClients.N°Client = [rqtFreqVisites-dernierParClient1].N°Client WHERE (((tblClients.TCI)= " & "'" & nomTCI & "'" & "))" End If End If 'Pour appeler la fonction qui ouvre la boite de dialogue Enregistrer sous 'Utilisation d'une "requête temporaire", car TransferSpreadsheet ne sait utiliser q'une table ou une requete ACCESS (objet requete), et non une instruction SQL tapé dans VBA Dim qd As QueryDef Set qd = CurrentDb.CreateQueryDef("Requete_Temporaire", rqtClients) DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Requete_Temporaire", "" & MsgBox(EnregistrerUnFichier(Me.hwnd, "Enregistrer sous", "GestionChiffreAffaires.xls", "" & MaBD1 & "")) & "" DoCmd.DeleteObject acQuery, "Requete_Temporaire"








Répondre avec citation
Partager