Qui peut trouver une solution au programme horaire ouvré

[pascb423]

Bonjour,
voici un petit programme excel qui calcul les heures ouvrées selon un horaire journalier et qui enlève les week end et les jours fériés.
Il ne tient pas compte des jours ouvrés non travaillé, j'aurais besoin d'inclure en plus de ce qu'il fait qu'il tienne compte des demi journées travaillées, par exemple il devrait déduire les dimi journées non travaillée du lundi au vendredi ou l'on puisse choisir si on tavail le lundi matin, le lundi après midi et ainsi de suite jusqu'a vendredi. merci pour celle ou celui qui pourrai se pencher sur une solution qui me rendrais vraiment service.
voici la programmation en vba et le fichier en pièce jointe:

23456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131 Public DaDeb As Date
 
Function ExistDansTableau(Valeur, Tablo) As Boolean
Dim i As Long
    ExistDansTableau = False
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        If Tablo(i, 1) = Valeur Then
            ExistDansTableau = True
            Exit Function
        End If
    Next i
End Function
 
Function ProchainJourOuvré(DateJour As Date, JC) As Date
    If Weekday(DateJour) = 7 Then
        ProchainJourOuvré = ProchainJourOuvré(DateJour + 2, JC)
    ElseIf Weekday(DateJour) = 1 Then
        ProchainJourOuvré = ProchainJourOuvré(DateJour + 1, JC)
    ElseIf ExistDansTableau(DateJour, JC) Then
        ProchainJourOuvré = ProchainJourOuvré(DateJour + 1, JC)
    Else
        ProchainJourOuvré = DateJour
    End If
End Function
 
Function PlageEnCours(Heure As Double, PH As Variant, JC As Variant) As Long
Dim i As Long, NbJours As Long
    PlageEnCours = 0
    For i = 1 To UBound(PH, 1)
        If Heure >= PH(i, 1) And Heure <= PH(i, 2) Then
            PlageEnCours = i
            Exit Function
        End If
    Next i
    If PlageEnCours = 0 Then
    For i = UBound(PH, 1) To 1 Step -1
        If Heure > PH(i, 2) Then
            PlageEnCours = i + 1
            Exit For
        End If
    Next i
    If PlageEnCours = 0 Then
        PlageEnCours = 1
        DaDeb = ProchainJourOuvré(CDate(Fix(CDbl(DaDeb))), JC) + CDbl(PH(1, 1))
    End If
    End If
    If PlageEnCours > UBound(PH, 1) Then
        PlageEnCours = 1
        DaDeb = ProchainJourOuvré(CDate(Fix(CDbl(DaDeb))) + 1, JC) + CDbl(PH(1, 1))
    Else
        DaDeb = CDate(Fix(CDbl(DaDeb)) + CDbl(PH(PlageEnCours, 1)))
    End If
End Function
 
 
 
Function DateFin(DateDébut As Date, DuréeHeures As Double, PlagesJournée As Range, JoursCongés As Range) As Date
Dim HeureDébut As Double, HeureFin As Double, DateD As Long, DateF As Long
Dim PlageDeb As Long, PH, DaDeb2 As Date, JC, i As Long, j As Long, PlageF As Long
    PH = PlagesJournée.Value
    JC = JoursCongés.Value
    For i = 1 To UBound(PH, 1)
        For j = 1 To UBound(PH, 2)
            If Not (i = UBound(PH, 1) And j = UBound(PH, 2) And PH(i, j) = 1) Then
                PH(i, j) = CDate(PH(i, j) - Fix(PH(i, j)))
            End If
        Next j
    Next i
    DaDeb = DateDébut
    HeureDébut = CDbl(DateDébut) - Fix(CDbl(DateDébut))
    PlageDeb = PlageEnCours(HeureDébut, PH, JC)
    DaDeb2 = DaDeb
    HeureDébut = CDbl(DaDeb2) - Fix(CDbl(DaDeb2))
    DateD = Fix(CDbl(DaDeb2))
    DaDeb = DaDeb2 + DuréeHeures
    HeureFin = CDbl(DaDeb) - Fix(CDbl(DaDeb))
    PlageF = PlageEnCours(HeureFin, PH, JC)
    DateF = Fix(CDbl(DaDeb))
    If PlageDeb = PlageF And DateD = DateF Then
        DateFin = CDate(DaDeb2 + DuréeHeures)
    Else
        DuréeHeures = DuréeHeures - (PH(PlageDeb, 2) - HeureDébut)
        PlageDeb = PlageDeb + 1
        If PlageDeb > UBound(PH, 1) Then
            PlageDeb = 1
            DaDeb2 = ProchainJourOuvré(CDate(Fix(CDbl(DaDeb2))) + 1, JC) + CDbl(PH(1, 1))
        Else
            DaDeb2 = CDate(Fix(CDbl(DaDeb2)) + CDbl(PH(PlageDeb, 1)))
        End If
        DateFin = DateFin(DaDeb2, DuréeHeures, PlagesJournée, JoursCongés)
    End If
End Function
 
Function HeuresOuvr(DateDébut As Date, DateFin As Date, PlagesJournée As Range, JoursCongés As Range) As Double
Dim PH, JC, i As Long, j As Long, DaDeb2 As Date, HeureDébut As Double, PlageDeb As Long, DateD As Date
Dim DateF As Date, PlageF As Long, HeureF As Double, DaFin2 As Date, AncPlageDeb As Long
    PH = PlagesJournée.Value
    JC = JoursCongés.Value
    For i = 1 To UBound(PH, 1)
        For j = 1 To UBound(PH, 2)
            If Not (i = UBound(PH, 1) And j = UBound(PH, 2) And PH(i, j) = 1) Then
                PH(i, j) = CDate(PH(i, j) - Fix(PH(i, j)))
            End If
        Next j
    Next i
    DaDeb = DateDébut
    HeureDébut = CDbl(DateDébut) - Fix(CDbl(DateDébut))
    PlageDeb = PlageEnCours(HeureDébut, PH, JC)
    DaDeb2 = DaDeb
    HeureDébut = CDbl(DaDeb2) - Fix(CDbl(DaDeb2))
    DateD = Fix(CDbl(DaDeb2))
    DaDeb = DateFin
    HeureF = CDbl(DateFin) - Fix(CDbl(DateFin))
    PlageF = PlageEnCours(HeureF, PH, JC)
    DaFin2 = DaDeb
    HeureF = CDbl(DaFin2) - Fix(CDbl(DaFin2))
    DateF = Fix(CDbl(DaFin2))
    If PlageDeb = PlageF And DateD = DateF Then
        HeuresOuvr = CDbl(DaFin2 - DaDeb2)
    Else
        AncPlageDeb = PlageDeb
        PlageDeb = PlageDeb + 1
        If PlageDeb > UBound(PH, 1) Then
            PlageDeb = 1
            DaDeb2 = ProchainJourOuvré(CDate(Fix(CDbl(DaDeb2))) + 1, JC) + CDbl(PH(1, 1))
        Else
            DaDeb2 = CDate(Fix(CDbl(DaDeb2)) + CDbl(PH(PlageDeb, 1)))
        End If
        HeuresOuvr = PH(AncPlageDeb, 2) - HeureDébut + HeuresOuvr(DaDeb2, DaFin2, PlagesJournée, JoursCongés)
    End If
End Function