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
|
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim strSQL As String
Dim strWhere As String
Dim strNomReq As String
strNomReq = "Req_Stat_prêt1"
Set MyDB = CurrentDb()
'Création requête regroupement du nombre de prêts par mois compris entre les dates de départ et dates de sortie du formulaire 'Mouvements'
strSQL = "SELECT DateSerial(Year(Date_de_sortie), Month(Date_de_sortie), 1) As Mois_sortie, Count (ID_mouvement) AS Total_prêts " & _
"FROM Mouvements " & _
"Where (Date_de_sortie Between Forms.Historique_prêts.Date_départ And Forms.Historique_prêts.Date_fin)" & _
"GROUP BY DateSerial(Year(Date_de_sortie), Month(Date_de_sortie), 1)"
strSQL = strSQL & strWhere
If TesteExistenceRequete(strNomReq) Then
MyDB.QueryDefs.Delete strNomReq
Set qdef = MyDB.CreateQueryDef(strNomReq, strSQL)
Else
Set qdef = MyDB.CreateQueryDef(strNomReq, strSQL)
End If
'Création table des mois théoriques entre la date de départ et la date de fin
Dim oNouvelleTable As DAO.TableDef
Dim oRst As DAO.Recordset
Dim oChamp As DAO.Field
Dim strNomTable As String
Dim MoisDep As Date 'mois de départ
Dim Nb As Integer
Dim i As Integer
Nb = DateDiff("m", Forms.Historique_prêts.Date_départ, Forms.Historique_prêts.Date_fin)
MoisDep = Form_Historique_prêts.Date_départ.Value
MyDB.TableDefs.Refresh
strNomTable = "Mois_Ref"
If VerifierExistenceTable(strNomTable:=strNomTable) = True Then
MyDB.TableDefs.Delete "Mois_Ref"
'Crée la nouvelle table
Set oNouvelleTable = MyDB.CreateTableDef(strNomTable)
'Crée le champ Mois
Set oChamp = oNouvelleTable.CreateField("Mois", dbDate)
oNouvelleTable.Fields.Append oChamp
MyDB.TableDefs.Append oNouvelleTable
Else
Set oNouvelleTable = MyDB.CreateTableDef(strNomTable)
Set oChamp = oNouvelleTable.CreateField("Mois", dbDate)
oNouvelleTable.Fields.Append oChamp
MyDB.TableDefs.Append oNouvelleTable
End If
' crèe la boucle pour remplir la table
For i = 1 To Nb + 1
Set oRst = MyDB.OpenRecordset(strNomTable, dbOpenTable)
oRst.AddNew
oRst.Fields("Mois").Value = DateAdd("m", i - 1, MoisDep)
oRst.Update
Next i
Set oChamp = Nothing
Set oNouvelleTable = Nothing
'Crée la requête liant la table et la requête et donnant une valeur 0 aux mois vides.
strNomReq = "Req_Stat_prêt2"
strSQL = "SELECT Mois_Ref.Mois, Req_Stat_prêt1.Total_prêts, IIf(Total_Prêts Not Like '',Total_prêts, 0) AS Prêts_mois " & _
"FROM Req_Stat_prêt1 " & _
"Right Join Mois_Ref On Req_Stat_prêt1.Mois_sortie = Mois_Ref.mois"
If TesteExistenceRequete(strNomReq) Then
MyDB.QueryDefs.Delete strNomReq
Set qdef = MyDB.CreateQueryDef(strNomReq, strSQL)
Else
Set qdef = MyDB.CreateQueryDef(strNomReq, strSQL)
End If
MyDB.Close
Set oRst = Nothing
Set MyDB = Nothing
Set qdef = Nothing |
Partager