| 12
 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
 
 | 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 | 
Partager