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
94
95
96
97
98
99
100
101
| Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) _
As Long
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
Private Sub Export_Click()
On Error GoTo Err_Export_Click
Dim qdf As DAO.QueryDef
Dim rcs As DAO.Recordset
Dim chn As String
Dim dlgSaveAs As FileDialog
If Me.listeNom.Value <> "" Or Me.listeNom.Value <> " " Then
'On récupère tous les enregsitrements sans filtre
chn = "SELECT [Table PRE-SYNTHESE_CONSOMME].societe AS Société, [Table PRE-SYNTHESE_CONSOMME].nom AS Nom, [Table PRE-SYNTHESE_CONSOMME].codeDO AS DO, [Table PRE-SYNTHESE_CONSOMME].codeCCD AS Type, [Table PRE-SYNTHESE_CONSOMME].lotposte AS [Lot Poste], [Table PRE-SYNTHESE_CONSOMME].lieu AS Lieu, [Table PRE-SYNTHESE_CONSOMME].prodsociete AS Prod, [Table PRE-SYNTHESE_CONSOMME].delta AS Régul, [Table PRE-SYNTHESE_CONSOMME].fact AS Fact, [Table PRE-SYNTHESE_CONSOMME].commentaire AS Commentaire FROM [Table PRE-SYNTHESE_CONSOMME] WHERE (resp=" + "'" + Me.listeNom.Value + "')"
If Me.CheckValidation.Value = True Then
'Seulement les enregistrements validés
chn = chn & "AND (validation <>'' OR validation <>' ')"
End If
If (Me.ListeProjet.Value <> " " Or Me.ListeProjet.Value <> "") Then
'le RA + le projet de la liste
chn = chn & " AND (projet='" & Me.ListeProjet.Value & "')"
End If
If (Me.ListeRessource.Value <> " " Or Me.ListeRessource.Value <> "") Then
'le RA + le projet de la liste + la ressource de la liste
chn = chn & " AND (nom='" & Me.ListeRessource.Value & "')"
End If
Set qdf = CurrentDb.QueryDefs("R EXPORT Excel")
qdf.SQL = chn
'Set dlgSaveAs = Application.FileDialog(msoFileDialogSaveAs)
Chemin = EnregistrerUnFichier(Me.hWnd, "Enregistrer sous", "Export.xls", "C:\")
'dlgSaveAs.Show
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "R EXPORT Excel", Chemin, True
Else
MsgBox "Vous devez choisir un reponsable d'activité"
End If
Exit_Export_Click:
Exit Sub
Err_Export_Click:
MsgBox Err.Description
Resume Exit_Export_Click
End Sub
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)
.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 |
