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 |
Partager