calcul taux dispo [Résolu]

[debutVBA]

Bonjour à tous et toutes ,



Donc je suis en train d'essayer de terminer mon jolie programme mais je suis vraiment coincé sur le dernier code à effectuer donc je m'explique

il faut que je calcule le taux de diponibilité du parc ,
le nombre de machines sera donc une saisie écran,l'utilisateur donnera donc un nombre de machines


les contraintes sont aussi qu'une journée fait 10 heures :de 8heures à 18heures
Les week ends et jours féries ne sont pas compté également.

*Taux de disponibilité du parc 98%
les pénalités associés sont entre 97 et 97.99% 2000€
entre 96 et 96.99% 4250€
entre 0 et 95.99% 6890€


*Plafond pénalités annuelles 21000€


le code associé :

Code :

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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
Public colDateEnv, colDateClot, objJferies, ForWriting, nbmachines
 
Sub calculPE()
 
Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
 
             nbmachines = Application.InputBox(" Combien de machines a saisir", Type:=1)
 
 
colDateEnv = 16
colDateClot = 18
 
Set objJferies = CreateObject("Scripting.Dictionary")
objJferies.CompareMode = vbTextCompare
 
'On ouvre le classeur
Dim monClasseur As Workbook
Set monClasseur = ActiveWorkbook
 
monClasseur.Worksheets("JFériésExcep").Activate
' On lit la feuille des jours fériés
For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
  objJferies.Add Cells(ligne, 1).Value, True
 
Next
 
 
'on ouvre la feuille
Dim maFeuille As Worksheet
Set maFeuille = monClasseur.Worksheets("etat")
 
'on active la feuille
monClasseur.Worksheets("etat").Activate
 
'appel la fonction HeuresT
Call HeuresT
 
End Sub
 
 
Function Work_Days(BegDate As Date, EndDate As Date, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim dt As Date
 
On Error GoTo Work_Days_Error
    If IsNull(BegDate) Or IsNull(EndDate) Then err.Raise vbObjectError + 1
    If Not IsDate(BegDate) Or Not IsDate(EndDate) Then err.Raise vbObjectError + 2
    If BegDate > EndDate Then err.Raise vbObjectError + 3
 
    dt = BegDate
    Work_Days = 0
    While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And Not objJferies.exists(dt) Then
            Work_Days = Work_Days + 1
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = err.Description
    End Select
End Function
 
 
Public Function HeuresT()
 
    'les variables
    Dim nbJoursComplets As Long
    Dim nbHeuresAvant As Double
    Dim nbHeuresApres As Double
    Dim nbHeuresTotal As Double
    Dim nbJours As Integer
    Dim heuresRestantes As Double
    Dim minutesRestantes As Integer
    Dim leMois As String
 
    'ici il faut saisir un mois entre 1 et 12 ce qui correspond de janvier à Decembre
    leMois = Application.InputBox("Quel est le mois pour lequel vous souhaitez calculer les pénalités? (MM/AAAA)")
 
    If leMois = "" Or Len(leMois) <> 7 Then
      Exit Function
    End If
 
 
    'le compteur va servir à compter le nombre d'interventions d'un mois donné
    Dim compteur As Byte
    compteur = 0
 
    Dim PenaliteDeCeDossier As Long
    PenaliteDeCeDossier = 0
    Dim JoursSupplementaires As Long
    JoursSupplementaires = 0
    Dim SommePenaliteDuMois As Long
    SommePenaliteDuMois = 0
 
    StrPenalite = "Réparation" & vbTab & "Date d'envoi" & vbTab & vbTab & "Date clôture" & vbTab & vbTab & "Temps écoulé" & vbTab & vbTab & vbTab & "Pénalité (euros)"
 
    'ici j'indique en dur qu'il y a uniquement les 10 lignes dans le fichier (A modifier)
    For ligne = 2 To ActiveSheet.UsedRange.Rows.Count
 
    ' on recupere le mois de la date indiquée dans la cellule
        x = Right("0" & Month(Cells(ligne, colDateClot).Value), 2)
        x = x & "/" & Year(Cells(ligne, colDateClot).Value)
 
        If x = leMois Then
                'ici reste a verifier si la date est dans la liste des feries exceptionnels.
                'si c'est le cas ,on ne prend pas en compte cette date sinon,on peut continuer le calcul
                'condition qui servira a recuperer les cellules dont le mois correspond a celui dont on souhaite
                'y calculer ses pénalités
 
            'servira pour le nombre d'intervention
            compteur = compteur + 1
 
            'Le nombre de jours ouvrés total entre date1 à minuit "du soir" et date2 à minuit "du matin" !
            nbJoursComplets = Work_Days(DateValue(Cells(ligne, colDateEnv).Value), DateValue(Cells(ligne, colDateClot).Value), True) - 2
 
           'Le nombre d'heures travaillées entre date1 et date1 à 18h
           nbHeuresAvant = 0
           If Hour(Cells(ligne, colDateEnv).Value) < 18 Then
 
               If Hour(Cells(ligne, colDateEnv).Value) < 8 Then
                   nbHeuresAvant = 10
               Else
                   nbHeuresAvant = 18 - (Hour(Cells(ligne, colDateEnv).Value) + Minute(Cells(ligne, colDateEnv).Value) / 60)
               End If
 
           End If
 
           'Le nombre d'heures travaillées entre date2 à 8h et date2
           If Hour(Cells(ligne, colDateClot).Value) >= 8 Then
 
                If Hour(Cells(ligne, colDateClot).Value) >= 18 Then
                    nbHeuresApres = 10
                Else
                    nbHeuresApres = Hour(Cells(ligne, colDateClot).Value) + Minute(Cells(ligne, colDateClot).Value) / 60 - 8
                End If
 
            End If
 
            nbHeuresTotal = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
 
            'ici on recupere la partie entiere de nbHeuresTotal pour indiqué en nombre de jours
            nbJours = Int(nbHeuresTotal / 10)
            nbj = nbHeuresTotal / 10
            heuresRestantes = nbHeuresTotal - nbJours * 10
            minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
 
            HeuresT = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
 
            PenaliteDeCeDossier = 0
                   '  Indisponibilité > = à 1jours ou 10heures = 10€
                    If nbJours = 1 Then
                        PenaliteDeCeDossier = 10
 
                    ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
                    ElseIf nbJours = 2 Then
                        PenaliteDeCeDossier = 10 + 18
 
                    ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
                    ElseIf nbJours = 3 Then
                        PenaliteDeCeDossier = 10 + 18 + 25
 
                    ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
                    ElseIf nbJours >= 4 Then
                        JoursSupplementaires = nbJours - 3 ' pour avoir le nombre de jours supplementaires
                        PenaliteDeCeDossier = 10 + 18 + 25 + 25 * JoursSupplementaires
 
                    End If
 
            If PenaliteDeCeDossier <> 0 Then
                StrPenalite = StrPenalite & vbCrLf & Cells(ligne, 1).Value & vbTab & Cells(ligne, colDateEnv).Value & _
                            vbTab & Cells(ligne, colDateEnv).Value & vbTab & HeuresT & vbTab & _
                            Right("        " & PenaliteDeCeDossier, 7)
            End If
 
            PenaliteMois = PenaliteMois + PenaliteDeCeDossier
        End If
 
 End If
 
 
 
    Next
 
 
 
             'VOICI LA PARTIE OU JE TENTE DE CALCULER LE TAUX DE DISPONIBILTE
            'Pour le calcul taux de disponibilités
             If (DateDiff("n", Cells(ligne, colDateClot).Value, "01/" & leMois) Or DateDiff("n", Cells(ligne, colDateEnv).Value, "31/" & leMois)) Then
 
            MsgBox "rien du tout"
 
            Else
 
           date1 = Max(Cells(ligne, colDateEnv).Value, "01/" & leMois)
 
           date2 = Min(Cells(ligne, colDateClot).Value, "31/" & leMois)
 
 
                'pour avoir le taux de disponibilités.
                x = nbjoursOuvre * nbmachines / 10
 
 
              ' Taux de disponibilité du parc 98%
               If tauxDisponibilteParc >= 98 Then
               MsgBox "RIEN"
               e
                ' entre 97 et 97.99% 1500€
               ElseIf tauxDisponibilteParc >= 97 And tauxDisponibilteParc < 98 Then
               MsgBox " cela coute 1500"
 
               ' entre 96 et 96.99% 3000€
               ElseIf tauxDisponibilteParc >= 96 And tauxDisponibilteParc < 97 Then
               MsgBox "cela coute 3000 euros "
 
               ElseIf tauxDisponibilteParc >= 0 And tauxDisponibilteParc < 96 Then
               MsgBox "cela coute   4500€ "
 
               End If
 
 
 
 
    If compteur = 0 Then
       MsgBox "Bizarre!: aucun dossier trouvé pour la date de clôture choisie: " & leMois
    End If
 
    StrPenalite = StrPenalite & vbCrLf & vbCrLf & "Pénalité totale pour " & compteur & " dossiers: " & PenaliteMois & " euros"
    MsgBox StrPenalite
 
 
    ForWriting = 2
 
    'Pour creer le fichier texte
    Set FSys = CreateObject("Scripting.FileSystemObject")
    Set MonFic = FSys.OpenTextFile("C:\Users\US12\Desktop\fichier.txt", ForWriting, True)
    MonFic.WriteLine StrPenalite
    MonFic.Close
 
    End Function

Ps j'ai mis ce code dans un nouveau Topic car j'avais oublié de mettre en résolu mon ancien TOpic

[ZebreLoup]

Je suis désolé debutVBA, mais encore une fois, tu ne poses pas bien le problème. Je suis sûr que beaucoup de gens sur ce forum ont les connaissances pour t'aider à résoudre ton problème mais tu n'expliques pas ce que tu veux faire, ou du moins comment y arriver.

Il faut déjà avoir les idées claires "en français" avant de se lancer dans le VBA. Imagine que tu expliques à quelqu'un ce que tu veux calculer mais que ce quelqu'un n'y connait rien en VBA. Tu dois juste lui donner les étapes pour y parvenir.

Je ne sais pas par exemple pour le calcul du taux de disponibilité d'une machine, je suppose qu'il faut connaitre le nombre d'heures disponibles divisé par le nombre d'heures théoriques d'utilisation. Où sont ces données ?
Pourquoi le nombre de machines du parc est-il un paramètre ? Il faut avoir de toute façon les infos par machine pour que ça marche non ? A la rigueur, on pourrait vouloir calculer le taux de disponibilité d'une partie du parc, mais dans ce cas, outre le nombre de machine, c'est surtout quelles machines ?
Ou alors je n'ai encore rien compris au problème et c'est complètement autre chose.

Donc encore une fois, expose le problème comme si tu demandais à quelqu'un de faire le calcul avec un papier et un crayon !

[debutVBA]

Re zebre loup,

Oui je présente milles excuses car moi meme en me relisant je m'apercois que je n'ai pas été assez clair.

Donc je vais reexpliquer tout cela en étant le plus clair possible

Donc le parc possède un nombre de machine que je ne connais pas ,c'est donc l'utilisateur qui va saisir le nombre de machine d'ou l'utilité que le nombre de machine soit un paramètre

Ensuite effectivement,il faut que je puisse calculer le taux de disponibilté d'une machine.

Pour ce faire il y a un fichier qui indique tel ou tel machine a été indisponible de tel date a tel date,

exemple la machine1 est tombé en panne le 28/10/2010 et a été remise en marche le 2/11/2010

l'indisponibilité ne prend pas en compte les weekends et joursferiés Bien sur.


Ensuite par rapport a tes questions:

Je ne sais pas par exemple pour le calcul du taux de disponibilité d'une machine, je suppose qu'il faut connaitre le nombre d'heures disponibles divisé par le nombre d'heures théoriques d'utilisation. Où sont ces données

une journée fait 10 heures donc une machine peut etre au maximum etre disponible 10 heures par jour

a savoir également . Le taux de disponibilité est mensuel . Il n’est pas précisé sur quelles interventions ce taux est calculé. Si l’on veut pouvoir sortir une valeur dès le 1er jour du mois suivant, il ne faut prendre en compte que les interventions fermées dans le mois précédent (ainsi, une intervention ouverte en janvier et fermée en février sera comptabilisée en février)

J'espere avoir été plus clair

[ZebreLoup]

Tu aurais un petit fichier exemple, simplifié ? Je pourrais mieux t'aider je pense

[debutVBA]

Réparations 11-2011.xlsx
Re

voici le fichier avec les données

Est -il bien lisible ?

Merci à toi

[ZebreLoup]

Voilà, j'ai fait pas mal de modifications. Regarde tout ça et reviens-moi.
Il faut que Microsoft Scripting Runtime soit coché dans les références.
J'ai fait des fonctions pour que ce soit plus clair.

Code :

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
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
Option Explicit
 
Private Const colDateEnv As Integer = 16
Private Const colDateClot As Integer = 18
Private Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
Private joursFeries As Dictionary
 
 
Public Sub calculPE()
    Dim nbMachines As Integer
    Dim moisCalcul As String
    Dim dateCalcul As Date
 
    'Récupération des paramètres utilisateurs
 
    On Error Resume Next
 
    nbMachines = Application.InputBox(" Combien de machines a saisir", Type:=1)
    If Err.Number <> 0 Then MsgBox "Erreur dans la saisie du nombre de machines": Exit Sub
 
    moisCalcul = Application.InputBox("Quel est le mois pour lequel vous souhaitez calculer les pénalités? (MM/AAAA)")
    dateCalcul = DateDeMoisTexte(moisCalcul)
    If Err.Number <> 0 Then MsgBox "Erreur dans la saisie du mois": Exit Sub
 
    On Error GoTo 0
 
    'Création de la liste des jours fériés
    RemplirJoursFeries
 
    'Lancement des calculs
    Calculs dateCalcul, nbMachines
End Sub
 
 
Private Sub Calculs(ByVal dateMois As Date, ByVal nbMachines As Integer)
    Dim ws As Worksheet
    Dim ligne As Integer
    Dim debut, fin As Date
    Dim heures As Double
    Dim totalHeuresIncident As Double
    Dim totalHeures As Double
    Dim nbIntervention As Integer
    Dim penaliteDossier As Double
    Dim totalPenalites As Double
    Dim strPenalite As String
    Dim tauxDispo As Double
 
    Set ws = Worksheets("etat")
 
    ligne = 2
    nbIntervention = 0
    penaliteDossier = 0
    totalPenalites = 0
    totalHeuresIncident = 0
 
    totalHeures = heuresOuvreesSurMois(dateMois, DateSerial(Year(dateMois), Month(dateMois) + 1, 1), dateMois)
 
    strPenalite = "Réparation" & vbTab & "Date d'envoi" & vbTab & vbTab & "Date clôture" & vbTab & vbTab & "Temps écoulé" & vbTab & vbTab & vbTab & "Pénalité (euros)"
 
    Do While ws.Cells(ligne, "A").Value <> "" 'Pour chaque incident
        'On récupère la date de début et la date de fin
        debut = ws.Cells(ligne, colDateEnv).Value
        fin = ws.Cells(ligne, colDateClot).Value
 
        'On calcule le nombre d'heures ouvrées correspondant
        heures = heuresOuvreesSurMois(debut, fin, dateMois)
 
        If heures > 0 Then 'Si l'intervention est au moins en partie sur le mois cherché
            totalHeuresIncident = totalHeuresIncident + heures
            nbIntervention = nbIntervention + 1
 
            penaliteDossier = calculPenaliteDossier(Int(heures / 10))
            If penaliteDossier <> 0 Then
                strPenalite = strPenalite & vbCrLf & Cells(ligne, "A").Value & vbTab & Cells(ligne, colDateEnv).Value & _
                            vbTab & Cells(ligne, colDateEnv).Value & vbTab & heuresEnTexte(heures) & vbTab & _
                            Right("        " & strPenalite, 7)
            End If
 
            totalPenalites = totalPenalites + penaliteDossier
        End If
 
    Loop
 
    strPenalite = strPenalite & vbCrLf & vbCrLf & "Pénalité totale pour " & nbIntervention & " dossiers: " & totalPenalites & " euros"
 
    'Calcul du taux de dispo
    tauxDispo = (totalHeures - totalHeuresIncident) / (nbMachines * totalHeures)
 
    'Ajout de la pénalité supplémentaire
    If tauxDispo >= 97 And tauxDispo < 98 Then
        totalPenalites = totalPenalites + 1500
    ElseIf tauxDispo >= 96 And tauxDispo < 97 Then
        totalPenalites = totalPenalites + 3000
    ElseIf tauxDispo >= 0 And tauxDispo < 96 Then
        totalPenalites = totalPenalites + 4500
    End If
 
    'Plafond
    If totalPenalites > 21000 Then totalPenalites = 21000
 
    If nbIntervention = 0 Then
       MsgBox "Bizarre!: aucun dossier trouvé pour la date de clôture choisie: " & Format(dateMois, "mmmm yyyy")
    End If
 
    MsgBox strPenalite
 
     'Pour creer le fichier texte
    Dim FSys
    Dim MonFic
    Set FSys = CreateObject("Scripting.FileSystemObject")
    Set MonFic = FSys.OpenTextFile("C:\Users\US12\Desktop\fichier.txt", ForWriting, True)
    MonFic.WriteLine strPenalite
    MonFic.Close
End Sub
 
 
'Donne le premier jour du mois saisie par l'utilisateur
Private Function DateDeMoisTexte(ByVal moisTexte As String) As Date
    Dim moisTab() As String
    Dim mois, annee As String
 
    moisTab = Split(moisTexte, "/")
    If UBound(moisTab) <> 1 Then Err.Raise 1001
 
    mois = moisTab(0)
    annee = moisTab(1)
 
    If Len(mois) <> 2 Or Len(annee) <> 4 Then Err.Raise 1001
 
    On Error Resume Next
    DateDeMoisTexte = DateSerial(CInt(annee), CInt(mois), 1)
    If Err.Number <> 0 Then Err.Raise 1001
    On Error GoTo 0
End Function
 
'Remplit la liste des jours fériés
Private Sub RemplirJoursFeries()
    Dim ws As Worksheet
    Dim ligne As Integer
    Dim tmpDate As Date
 
    Set joursFeries = New Dictionary
    joursFeries.CompareMode = TextCompare
 
    Set ws = Worksheets("JFériésExcep")
 
    ligne = 2
    Do While ws.Cells(ligne, 1).Value <> ""
        tmpDate = ws.Cells(ligne, 1).Value
        If Not joursFeries.Exists(tmpDate) Then
            joursFeries.Add tmpDate, tmpDate
        End If
 
        ligne = ligne + 1
    Loop
End Sub
 
'Calcul le nombre d'heures ouvrées entre debut et fin sur le mois demandé
Private Function heuresOuvreesSurMois(ByVal debut As Date, ByVal fin As Date, ByVal mois As Date) As Double
    Dim moisSuivant As Date
 
    mois = DateSerial(Year(mois), Month(mois), 1)
    moisSuivant = DateSerial(Year(mois), Month(mois) + 1, 1)
 
    If debut >= moisSuivant Or fin < mois Then
        heuresOuvreesSurMois = 0
    Else
        debut = IIf(debut < mois, mois, debut)
        fin = IIf(fin > moisSuivant, moisSuivant, fin)
 
        heuresOuvreesSurMois = HeuresTravaillees(debut, fin, joursFeries)
    End If
End Function
 
'Calcul de la pénalité pour un dossier
Private Function calculPenaliteDossier(ByVal nbJours As Integer) As Double
    '  Indisponibilité > = à 1jours ou 10heures = 10€
    If nbJours = 1 Then
        calculPenaliteDossier = 10
    ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
    ElseIf nbJours = 2 Then
        calculPenaliteDossier = 10 + 18
    ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
    ElseIf nbJours = 3 Then
        calculPenaliteDossier = 10 + 18 + 25 * (nbJours - 2)
    Else
        calculPenaliteDossier = 0
    End If
End Function
 
'Tranformation du nombre d'heures en texte pour écrire dans le fichier
Private Function heuresEnTexte(ByVal heures As Double) As String
    Dim nbJours As Integer
    Dim heuresRestantes As Integer
    Dim minutesRestantes As Integer
 
    nbJours = Int(heures / 10)
    heuresRestantes = heures - nbJours * 10
    minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
 
    heuresEnTexte = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
End Function
 
Private Function HeuresTravaillees(ByVal debut As Date, ByVal fin As Date, objJferies As Object) As Double
 
    Dim nbJoursComplets As Integer
    Dim nbHeuresAvant As Double
    Dim nbHeuresApres As Double
 
    'Le nombre de jours ouvrés total entre date1 à minuit "du soir" et date2 à minuit "du matin" !
    nbJoursComplets = Work_Days(DateValue(debut), DateValue(fin), True, objJferies) - 2
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    nbHeuresAvant = 0
    If Hour(debut) < 18 Then
        If Hour(debut) < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (Hour(debut) + Minute(debut) / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    nbHeuresApres = 0
    If Hour(fin) >= 8 Then
        If Hour(fin) >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = Hour(fin) + Minute(fin) / 60 - 8
        End If
    End If
 
    HeuresTravaillees = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
 
End Function
 
Private Function Work_Days(ByVal BegDate As Date, ByVal EndDate As Date, _
                   Optional ByVal bAvecJFerie As Boolean = True, Optional objJferies As Object) As Variant
 
    Dim dt As Date
 
    On Error GoTo Work_Days_Error
 
    If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
    If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
    If BegDate > EndDate Then Err.Raise vbObjectError + 3
 
    dt = BegDate
    Work_Days = 0
    While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And Not objJferies.Exists(dt) Then
            If bAvecJFerie Then
                If Not objJferies.Exists(dt) Then Work_Days = Work_Days + 1
            Else
             Work_Days = Work_Days + 1
            End If
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = Err.Description
    End Select
End Function

[debutVBA]

Bonjour Zebre loup,

Merci pour cette explication,tes modifications sont clairs et j'ai pu comprendre enfin ..

Bravoooo

Il me faut encore beaucoup de pratique pour arriver à ce niveau !