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 132
| Option Explicit
Const H_1 As Date = #6:30:00 AM# '--- fin de nuit
Const H_2 As Date = #9:00:00 AM# '--- fin tôt le matin
Const H_3 As Date = #2:00:00 PM# '--- début soir samedi
Const H_4 As Date = #7:00:00 PM# '--- début soir semaine
Const H_5 As Date = #9:30:00 PM# '--- début de nuit
'--- les -0.0001 nécessaires pour éviter problèmes avec minuit: la date change à 00h00'00""
'--- ne traite pas le cas où le temps dépasse 24h consécutives
Public Function hTrf4(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
'--- calcul heures au tarif 4 - dimanche et jour férié
Debug.Print dD1, sF1, dD2, sF2
If Int(dD2 - 0.0001) = Int(dD1) Then
'--- jour fin = jour début
If sF1 = "x" Or sF2 = "x" Then '--- jour marqué férié
If (sF1 & sF2) = "xx" Then
hTrf4 = dD2 - dD1 '--- férié: tout au tarif 4
Else
hTrf4 = "? férié" '--- anomalie: manque un x
End If
Else
If Weekday(dD2) = 1 Then
hTrf4 = dD2 - dD1 '--- dimanche: tout au tarif 4
Else
hTrf4 = 0 '--- autre jour
End If
End If
ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
'--- jour fin > jour début
If sF1 = "x" Then
'--- jour début est férié
If sF2 = "x" Or Weekday(dD2) = 1 Then
hTrf4 = dD2 - dD1 '--- jour fin est férié ou dimanche
Else
hTrf4 = Int(dD2) - dD1 '--- jour fin est autre
End If
Else
'--- jour début n'est pas férié
If sF2 = "x" Or Weekday(dD2) = 1 Then
hTrf4 = dD2 - Int(dD2) '--- jour fin est férié ou dimanche
Else
hTrf4 = 0 '--- jour fin est autre
End If
End If
Else
hTrf4 = "fin < début?" '--- anomalie
End If
End Function
Public Function hTrf3(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
'--- calcul heures au tarif 3: nuit de H_5 (21h30) à H_1 (06h30)
Dim hTot As Double, hDeb As Double, hFin As Double
Debug.Print dD1, sF1, dD2, sF2
If Int(dD2 - 0.00001) = Int(dD1) Then
'--- début et fin sur la même journée
If Weekday(dD2) = 1 Or sF1 = "x" Or sF2 = "x" Then '--- dimanche ou férié
hTot = 0
Else
hTot = 0
hDeb = dD1 - Int(dD1)
hFin = dD2 - Int(dD2)
If hFin = 0 Then hFin = 1 '--- correction pour minuit
If hDeb < H_1 Then '--- début avant 6h30
If hFin > H_1 Then
hTot = H_1 - hDeb '--- fin après 6h30
Else
hTot = hFin - hDeb '--- fin avant 6h30
End If
End If
If hFin > H_5 Then '--- fin après 21h30
If hDeb < H_5 Then
hTot = hTot + hFin - H_5 '--- début avant 2130
Else
hTot = hTot + hFin - hDeb '--- début après 6h30
End If
End If
End If
ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
'--- fin jour après début
hTot = hTrf3(dD1, sF1, Int(dD2), sF1) + hTrf3(Int(dD2), sF2, dD2, sF2)
Else
hTot = "fin < début?" '--- anomalie
End If
hTrf3 = hTot
End Function
Public Function hTrf1(dD1 As Date, sF1 As String, dD2 As Date, sF2 As String) As Variant
'--- calcul heures au tarif 1: 100%
'--- en semaine: entre H_2 (09h00) et H_4 (19h00)
'--- le samedi:entre H_2 (09h00) et H_3 (14h00)
Dim hTot As Double, hDeb As Double, hFin As Double, H_Fin As Date
Debug.Print dD1, sF1, dD2, sF2
If Int(dD2 - 0.00001) = Int(dD1) Then
'--- début et fin sur la même journée
If Weekday(dD2) = 1 Or sF1 = "x" Or sF2 = "x" Then '--- dimanche ou férié
hTot = 0
Else
hTot = 0
hDeb = dD1 - Int(dD1)
hFin = dD2 - Int(dD2)
If Weekday(dD1) = 7 Then
H_Fin = H_3 '--- samedi: 14h00
Else
H_Fin = H_4 '--- semaine: 19h00
End If
If hDeb < H_2 Then '--- début avant 9h00
If hFin > H_Fin Then
hTot = H_Fin - H_2 '--- fin après 19h (14h)
Else
hTot = hFin - H_2 '--- fin avant 19h (14h)
End If
Else '--- début après 9h00
If hFin < H_Fin Then
hTot = H_Fin - hDeb '--- fin après 19h (14h)
Else
hTot = hFin - hDeb '--- fin avant 19h (14h)
End If
End If
End If
ElseIf Int(dD2 - 0.00001) > Int(dD1) Then
'--- fin jour après début
hTot = hTrf1(dD1, sF1, Int(dD2), sF1) + hTrf1(Int(dD2), sF2, dD2, sF2)
Else
hTot = "fin < début?" '--- anomalie
End If
hTrf1 = hTot
End Function
'--- pas de fonction hTrf2
'--- heures au tarif 2 obtenu par soustraction des 3 autres au temps total |
Partager