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