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
| Option Explicit
Sub JoursOuvrésAvecHeures()
Dim JourFérié()
Dim DateTraitement As String, DateDemande As String, HeureTraitement As String
Dim Heures As Single
Dim TempsCumulé As String, HeureDemande As String, TpsHeureTraitement As String, délaiH As String
Dim i As Date, n As Byte, NbJoursOuvrés As Integer, NbreJrs As Integer
Dim Férié As Boolean
Heures = 1 / 24 '0.041666666667 (N° de série)
DateDemande = "01/12/06"
DateTraitement = "04/12/2006" 'Format(Now(), "dd/mm/yy")
HeureDemande = "16:30"
HeureTraitement = "12:30"
'Calcul horaire entre heure de la demande et heure du traitement
If TimeValue(HeureTraitement) > TimeValue(HeureDemande) Then
TpsHeureTraitement = TimeValue(HeureTraitement) - TimeValue(HeureDemande)
Else
TpsHeureTraitement = (9 * Heures) - (TimeValue(HeureDemande) - TimeValue(HeureTraitement))
End If
JourFérié = Array("01/01/2006", "24/04/06", "01/05/06", "08/05/06", "15/05/2006", "28/05/06", _
"14/07/06", "15/08/06", "01/01/2007", "25/12/2006", "1/11/2006", "11/11/2006") ' etc
n = 0
For i = DateValue(DateDemande) + 1 To DateValue(DateTraitement)
If CStr(Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
For n = 0 To UBound(JourFérié)
Férié = i = DateValue(JourFérié(n)) ''si vrai, Férié = -1
If Férié Then Exit For
Next
'si on a un jour férié, on le retranche
NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
End If
Next
If TimeValue(HeureTraitement) < TimeValue(HeureDemande) Then NbJoursOuvrés = NbJoursOuvrés - 1
If TpsHeureTraitement >= (9 * Heures) Then
NbreJrs = Int((TpsHeureTraitement / (9 * Heures)) + 0.0000001) 'ROUNDUP/ARRONDI.SUP
NbJoursOuvrés = NbJoursOuvrés + NbreJrs
TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * NbreJrs)
End If
délaiH = Format(TpsHeureTraitement, "hh:nn")
MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
End Sub |
Partager