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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| Public Function Liste_FM_FP(Annee As Integer, DateDebut As Date, DateFin As Date, CodeChoix As Integer, CodeImmeuble As Integer)
Dim reponse
Dim Canal As Long
' Variable devant contenir la référence à Microsoft Excel.
Dim MyXLS As Object
' Indicateur pour la libération à la fin.
Dim ExcelWasNotRunning As Boolean
Dim db As Database
Dim Requete As String
Dim Cursor As Recordset
Dim VarRecordsEvts As Variant
Dim i_maxEvts As Integer
Dim i_occEvts As Integer
i_occEvts = 0
Dim lig As Integer
Dim lig1 As Integer
lig1 = 0
Dim position As String
On Error Resume Next
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
Set db = CurrentDb()
' Test pour déterminer si une copie de Microsoft Excel
' est déjà en exécution.
' La fonction Getobject appelée sans le premier
' argument renvoie une référence à une occurrence de
' l'application. Si l'application n'est pas en
' exécution, une erreur se produit.
Set MyXLS = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
ExcelWasNotRunning = True
Err.Clear ' Efface l'objet Err si une erreur s'est produite.
End If
' Définit la variable objet pour qu'elle fasse
' référence au fichier à ouvrir.
Set MyXLS = GetObject("c:\Mesdocs\Salaries\Documents\Listes\Fete_des_meres_Fete_des_peres.XLS")
' Affiche Microsoft Excel par l'intermédiaire de sa
' propriété Application. Affiche ensuite la fenêtre
' contenant le fichier à l'aide de la collection
' Windows de la référence à l'objet MyXLS.
MyXLS.Application.Visible = True
MyXLS.Parent.Windows(1).Visible = True
'Permet d'entamer la "conversation" dynamique d'échange de données avec Excel
Canal = DDEInitiate("Excel", "feuil1")
Requete = "SELECT Evenements.NumMatricule, Evenements.DateEvt, Salaries.Nom, Salaries.Prenom, Salaries.Qualite, TypesChoix.LibTypeChoix, Immeubles.LibImmeuble " & _
" FROM Evenements, Salaries, TypesChoix, Immeubles " & _
" WHERE (Evenements.TypeEvt = 2 " & _
" OR Evenements.TypeEvt = 3 ) " & _
" AND Evenements.AnneeEvt = " & Annee & _
" AND (Evenements.DateEvt > " & Chr$(35) & Format(DateDebut, "m/d/yy") & Chr$(35) & _
" OR Evenements.DateEvt = " & Chr$(35) & Format(DateDebut, "m/d/yy") & Chr$(35) & " ) " & _
" AND (Evenements.DateEvt < " & Chr$(35) & Format(DateFin, "m/d/yy") & Chr$(35) & _
" OR Evenements.DateEvt = " & Chr$(35) & Format(DateFin, "m/d/yy") & Chr$(35) & " ) " & _
" AND Evenements.NumMatricule = Salaries.NumMatricule " & _
" AND Evenements.TypeChoix = " & CodeChoix & _
" AND TypesChoix.CodeTypeChoix = " & CodeChoix & _
" AND Salaries.CodeImmeuble = " & CodeImmeuble & _
" AND Immeubles.CodeImmeuble = " & CodeImmeuble & _
" ORDER BY Salaries.Nom "
Set Cursor = db.OpenRecordset(Requete)
If Cursor.EOF = True Then
Cursor.Close
Exit Function
End If
'Permet le comptage des occ.
Cursor.MoveLast
Cursor.MoveFirst
i_maxEvts = Cursor.RecordCount
'Charge les occ. dans le tableau varRecords (position courante sur le 1er)
VarRecordsEvts = Cursor.GetRows(i_maxEvts)
Cursor.Close
lig = 2
Do
' Date Evt
position = "L" & lig & "C1"
DDEPoke Canal, position, VarRecordsEvts(1, i_occEvts)
' Matricule
position = "L" & lig & "C2"
DDEPoke Canal, position, VarRecordsEvts(0, i_occEvts)
' Qualité
position = "L" & lig & "C3"
DDEPoke Canal, position, UCase(VarRecordsEvts(4, i_occEvts))
' Nom
position = "L" & lig & "C4"
DDEPoke Canal, position, UCase(VarRecordsEvts(2, i_occEvts))
' Prénom
position = "L" & lig & "C5"
DDEPoke Canal, position, VarRecordsEvts(3, i_occEvts)
' Immeuble
position = "L" & lig & "C6"
DDEPoke Canal, position, VarRecordsEvts(6, i_occEvts)
lig = lig + 1
i_occEvts = i_occEvts + 1
Loop Until i_occEvts = i_maxEvts
'Fermeture du canal DDE
DDETerminate Canal
' Si cette copie de Microsoft Excel n'était pas déjà en
' exécution lorsque vous l'avez utilisée, elle est
' fermée à l'aide de la méthode Quit de la propriété Application.
' Notez que si vous tentez de quitter Microsoft Excel,
' la barre de titre Microsoft Excel clignote etMicrosoft Excel
' affiche un message vous demandant si vous souhaitez enregistrer les fichiers chargés.
If ExcelWasNotRunning = True Then
MyXLS.Application.Quit
End If
' Libère la référence à l'application et à la feuille de calcul
Set MyXLS = Nothing
End Function |
