Discussion :

[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:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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