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
| Sub CreeMonCalendrier(ByVal MonDepart As Date)
Dim MesFabrications As Recordset
Dim Mafin As Date
Set MesFabrications = CurrentDb.OpenRecordset("Select * from Table2 Order By [ordre de fabrication]", dbOpenSnapshot)
With MesFabrications
While Not .EOF
Mafin = CalculDateFin(MonDepart, !temps_fabrication)
CurrentDb.Execute "INSERT INTO Table4 (ordre, designation,qte,[date de début],[date de fin]) values (" & _
![ordre de fabrication] & ",'" & !désignation & "'," & !qte & ",#" & _
Format(MonDepart, "mm/dd/yyyy hh:mm") & "#,#" & Format(Mafin, "mm/dd/yyyy hh:mm") & "#)"
MonDepart = Mafin
.MoveNext
Wend
End With
End Sub
Function CalculDateFin(ByVal Debut As Date, ByVal Temps As Integer) As Date
Dim heurefin As Date
Dim NbhRestante As Integer
Dim Mafin As Date
Dim heuredebut As Date
heurefin = DLookup("fin", "table1", "jour='" & Format(Debut, "dddd") & "'")
NbhRestante = Temps - (DateDiff("h", Format(Debut, "hh:mm"), heurefin))
If NbhRestante > 0 Then
Mafin = Debut
While NbhRestante > 0
Do
Mafin = Mafin + 1
Loop While JourChome(Mafin)
heuredebut = DLookup("départ", "table1", "jour='" & Format(Mafin, "dddd") & "'")
Mafin = DateAdd("h", NbhRestante, DateSerial(Year(Mafin), Month(Mafin), Day(Mafin)) + heuredebut)
heurefin = DLookup("fin", "table1", "jour='" & Format(Mafin, "dddd") & "'")
NbhRestante = (DateDiff("h", heurefin, Format(Mafin, "hh:mm")))
Wend
Else
Mafin = DateAdd("h", Temps, Debut)
End If
CalculDateFin = Mafin
End Function
Function JourChome(ByVal pdDate As Date) As Boolean
Select Case Format(pdDate, "w", vbMonday)
Case 6, 7 'Samedi et dimanche
JourChome = True
Case Else 'Autres jour de la semaine
If EstFerie(pdDate) Then
JourChome = True
Else
JourChome = False
End If
End Select
End Function
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim I As Integer
anneeDate = Year(QuelleDate)
joursFeries(1) = DateSerial(anneeDate, 1, 1)
joursFeries(2) = DateSerial(anneeDate, 5, 1)
joursFeries(3) = DateSerial(anneeDate, 5, 8)
joursFeries(4) = DateSerial(anneeDate, 7, 14)
joursFeries(5) = DateSerial(anneeDate, 8, 15)
joursFeries(6) = DateSerial(anneeDate, 11, 1)
joursFeries(7) = DateSerial(anneeDate, 11, 11)
joursFeries(8) = DateSerial(anneeDate, 12, 25)
joursFeries(9) = fLundiPaques(anneeDate)
joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Pâques + 38
joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
For I = 1 To 11
If QuelleDate = joursFeries(I) Then
EstFerie = True
Exit For
End If
Next
End Function
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
'Adapté de +ieurs scripts...
Dim L(6) As Long, Lj As Long, Lm As Long
L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
L(4) = (19 * L(1) + 24) Mod 30
L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
L(6) = 22 + L(4) + L(5)
If L(6) > 31 Then
Lj = L(6) - 31
Lm = 4
Else
Lj = L(6)
Lm = 3
End If
' Lundi de Pâques = Pâques + 1 jour
fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
End Function |
Partager