Discussion :

[debutVBA]

Bonjour à tous et à toutes ..

Tout d'abord je vous souhaite mes meilleurs voeux pour 2012 =) .... et beaucoup de santé ,d'argent et de code en perspective


Alors je cherche à soustraire deux dates mais le resultat doit faire en sorte de ne pas compter les jours feriés et les weeks end ..

Petit exemple

Difference de 31 /10 et 28 /10 doit afficher 1 car le 29,30 c'est le week ends

autre exemple : la différence entre le 30/12/2009
et le 04/01/2010 doit m'afficher 2 car le 1er janvier est férié et le 2 et 3 c'est le week end..

Quelqu'un aurait une idée ??


Merci par avance ..

[ZebreLoup]

Et la fonction NB.JOURS.OUVRES ?

[debutVBA]

Salut ZebreLoup,

j'ai essayé ceci NombreDeJoursOuvres = NB.JOURS.OUVRES((Cells(ligne, 16).Value), (Cells(ligne, 18).Value)

mais visiblement ce n'est pas la bonne synthaxe ...



Merci à toi

[SfJ5Rpw8]

Pourquoi vouloir faire cela en VBA ? utilise la fonction indiquée plus haut directement dans excel ..

[debutVBA]

Salut bbil ,


En faite je dois absolument utiliser une macro c'est pour cela que je cherche à savoir comment calculer le nombre de jours entre deux dates sans prendre en compte les jours feries et les week ends.

Merci à toi =)

[ZebreLoup]

Tu as la fonction workday en VBA qui normalement est disponible si tu coches atpvbaen.xls dans les références. Mais je crois que ça dépend de la version d'Excel.

[MarcelG]

Bonjour à tous.

Tout d'abord, je vous adresse mes meilleurs voeux pour 2012.
Longue vie au Forum!

La fonction suivante Work_Days retourne le nombre de jours ouvrés en tenant compte des bornes comprises.

(à adapter)

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
Function Work_Days(BegDate As Variant, EndDate As Variant, _
                   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 IIf(bAvecJFerie, Not EstFerie(dt), True) 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
 
 
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

[debutVBA]

Merci à tous,j'ai compris pour les jours fériés et les week ends =) !

En faite maintenant pour corsé un peu =)


une journée est égale à 10 heures de temps ( de 8heures à 18 heures )

exemple ouverture d'un incident le 2/01/2012 à 14h48 et fermeture de celui-ci
le 3/01/2012 à 9 heures

le 2/01 de 14heures 48 à 18heures il y a 3 heures et 12 minutes
le 3/01 de 8heures à 9 heures il y a qu'une heures
donc 3heures et 12 minutes + 1 heures = 4heures et 12 minutes donc ca correspond pas a une journéeLa ou ca se corse :

exemple ouverture d'un incident le 28/10/2010 à 12 heures et fermeture de celui-ci le 2/11/2010 à 9 heures

le 28/10/2010 de 12heures à 18heures il y a 6 heures
le 29 il y a 10 heures qui se passe (de 8heures à 18 heures )donc une journée
Le 30,31 c"'est le week end donc on ne calcul pas les heures
si ça avait été aussi un jour férié on n'aurait pas calculé également.
Le 01/11/2010 il se passe 10 heures (de 8 heures a 18heures ) donc une journée.
le 2/11/2010 de 8 heures à 14 heures il y a 6 heures

donc si on calcule le nombre de jours entre le 2/11/2010 et le 28/10/2010
il y a 6heures +10 heures + 10 heures + 6 heures ce qui fait
3 jours + 2 heures ou 32 heures


donc en gros la je suis dans un cas supérieur à 3 jours ..

Je ne vois vraiment pas comment coder cela !!!!
Je sais c'est complexe !!!!!!


Merci à tous en tout cas pour votre aide =)

[MarcelG]

Salut,

Regarde cette discussiion.

PLAGE HORAIRE

[debutVBA]

salut,

Code :

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

1
2
3
4
5
Public Function HeuresTravail(date1 As Date, heure1 As Long, date2 As Date, heure2 As Long) As Long
'36000 = 10 heures * 60 minutes * 60 secondes
diff = ((Work_Days(date1, date2) - 1) * 36000 - (heure1 - heure2))
HeuresTravail = diff
End Function

Merci pour l'info mais comment récuperer l'heure de date1 et de date2 pour que je les passe en parametre.

[ZebreLoup]

Regarde une petite adaptation. Attention, ce n'est pas optimisé, c'est pour bien comprendre la démarche. Je renvoie un double ici car je rajoute les minutes après la virgules.

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
Public Function HeuresTravail(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1, date2, True) - 1
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If date1.Hour < 18 Then
        If date1.Hour < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (date1.Hour + date1.Minute / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If date2.Hour >= 8 Then
        If date2.Hour >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = date2.Hour + date2.Minute / 60 - 8
        End If
    End If
 
    heuretravail = 10 * nbjourscomplet + nbHeuresAvant + nbHeuresApres
End Function

[debutVBA]

bonjour,


Visiblement lorsque j'execute la macro il indique le message d'erreur suivant :

Qualificateur incorrect en soulignant date 1

Code :

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

 If TimeValue(date1.Value) < 18 Then

ceci concerne la fonction ci dessous :

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
Public Function HeuresTravail(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1, date2, True) - 1
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If date1.Hour < 18 Then
        If date1.Hour < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (date1.Hour + date1.Minute / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If date2.Hour >= 8 Then
        If date2.Hour >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = date2.Hour + date2.Minute / 60 - 8
        End If
    End If
 
    heuretravail = 10 * nbjourscomplet + nbHeuresAvant + nbHeuresApres
End Function

[ZebreLoup]

Euh c'est bizarre tu parles d'une erreur sur une ligne qui n'existe pas dans le code, tu l'as modifié ?

[debutVBA]

Bonjour zebre loup,

j'ai effectivement modifié pour essayer de réadapter le code mais cela ne fonctionne pas.

j'ai aussi laissé la ligne de code que tu avais proposé initialement mais cela ne change rien visiblement ,je vais poster mon code pour que ce soit plus parlant

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
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
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
Sub calculSanction()
 
 
'On ouvre le classeur
Dim monClasseur As Workbook
Set monClasseur = Workbooks("monclasseur.xlsm")
 
'on ouvre la feuille
Dim maFeuille As Worksheet
Set maFeuille = monClasseur.Worksheets("etat")
 
 
'on active la feuille
monClasseur.Worksheets("etat").Activate
 
 
Call QuelMoisACalculer
 
 
End Sub
 
'cette fonction renvoit la difference entre deux dates.
Function NbJours(d1 As Date, d2 As Date) As Integer
    NbJours = DateDiff("d", d1, d2)
End Function
 
 
Function QuelMoisACalculer()
 
Dim leMois As Byte
leMois = Application.InputBox("quel est le mois que vous souhaitez calculer les pénalités", Type:=1)
 
Dim compteur As Byte
compteur = 0
 
 
Dim PenaliteDeCeDossier As Long
PenaliteDeCeDossier = 0
 
Dim JoursSupplementaires As Long
JoursSupplementaires = 0
 
Dim SommePenaliteDuMois As Long
SommePenaliteDuMois = 0
 
 
 
 
For ligne = 2 To 10
 
' on recupere le mois de la date indiqué dans la cellule
x = Month(Cells(ligne, 16).Value)
 
 
If x = leMois Then
 
compteur = compteur + 1
 
 
 
 
' calculer la difference entre deux dates pour avoir le nombre de jour entre l'ouverture de l'intervention et sa cloture
 
        nbj = NombreJoursDiff(Cells(ligne, 16), Cells(ligne, 18))
 
 
 
 
       ' calcule du nombre d'heures entre deux dates donnés
 
         nomH = HeuresTravailles(Cells(ligne, 16), Cells(ligne, 18))
 
 
        MsgBox " le nombre d'heures de ces deux dates est de " & nomH
 
        nbjj = nbjourouvrable(Cells(ligne, 16), Cells(ligne, 18))
 
 
      MsgBox " le nombre de jours entre la date d'ouverture de l'intervention et de sa cloture est de  " & nbjj
 
       ' MsgBox " le nombre de jours entre la date d'ouverture de l'intervention et de sa cloture est de  " & a
 
 
 
 
 
 
           '  Indisponibilité > = à 1jours ou 10heures = 10€
            If nbjj = 1 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10
 
 
            ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
            ElseIf nbjj = 2 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18
 
 
            ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
            ElseIf nbjj = 3 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18 + 25
 
 
 
            ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
            ElseIf nbjj > 3 Then
            JoursSupplementaires = nbj - 4 ' pour avoir le nombre de jours supplementaires
 
            PenaliteDeCeDossier = PenaliteDeCeDossier + 53 + 25 * JoursSupplementaires
 
 
            End If
 
 
SommePenaliteDuMois = SommePenaliteDuMois + PenaliteDeCeDossier
 
 
 
End If
 
 
Next
 
MsgBox "la penalite du mois  " & leMois & "   duquel on a souhaite calculer la penalite est de " & SommePenaliteDuMois
MsgBox "le nombre d'intervention du mois " & leMois & " est de " & compteur
 
 
End Function
 
Function NombreJoursDiff(d1 As Date, d2 As Date) As Integer
    NombreJoursDiff = DateDiff("d", d1, d2)
End Function
 
Function nbjourouvrable(datdeb, datfin)
If datdeb = "" Or datfin = "" Then Exit Function
 
nbjourtot = DateDiff("d", datdeb, datfin) + 1
 
For i = 1 To nbjourtot
 
  If ferie(datdeb) Then
   nbjourtot = nbjourtot - 1
  End If
 
 datdeb = DateAdd("d", 1, datdeb)
 
Next
nbjourouvrable = nbjourtot
 
End Function
 
Function ferie(Jour)
If Jour = "" Then Exit Function
Dim JJ, AA
Dim NbOr, Epacte
Dim PLune, Paques, Ascension, Pentecote
 
JJ = Day(Jour)
mm = Month(Jour)
AA = Year(Jour)
 
If JJ = 1 And mm = 1 Then ferie = True: Exit Function     '1 Janvier
If JJ = 1 And mm = 5 Then ferie = True: Exit Function     '1 Mai
If JJ = 8 And mm = 5 Then ferie = True: Exit Function     '8 Mai
If JJ = 14 And mm = 7 Then ferie = True: Exit Function   '14 Juillet
If JJ = 15 And mm = 8 Then ferie = True: Exit Function   '15 Août
If JJ = 1 And mm = 11 Then ferie = True: Exit Function   '1 Novembre
If JJ = 11 And mm = 11 Then ferie = True: Exit Function '11 Novembre
If JJ = 25 And mm = 12 Then ferie = True: Exit Function '25 Décembre
NbOr = (AA Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1
 
Paques = PLune - Weekday(PLune) + vbMonday + 7  'Paques
If JJ = Day(Paques) And mm = Month(Paques) Then ferie = True: Exit Function
 
Ascension = Paques + 38 'Ascension
If JJ = Day(Ascension) And mm = Month(Ascension) Then ferie = True: Exit Function
 
Pentecote = Ascension + 11 'Pentecote
If JJ = Day(Pentecote) And mm = Month(Pentecote) Then ferie = True: Exit Function
ferie = False
Dim numjour
numjour = Weekday(Jour, vbMonday)    'fixe à 6 et 7 la valeur du samedi & dimanche
If numjour = 6 Or numjour = 7 Then ferie = True: Exit Function
End Function
 
 
Public Function HeuresTravail(date1 As Date, heure1 As Long, date2 As Date, heure2 As Long) As Long
'36000 = 10 heures * 60 minutes * 60 secondes
diff = ((Work_Days(date1, date2) - 1) * 36000 - (heure1 - heure2))
HeuresTravail = diff
End Function
 
 
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 IIf(bAvecJFerie, Not EstFerie(dt), True) 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
 
 
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function
 
 
 
 
Public Function HeuresTravailles(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1, date2, True) - 1
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If date1.Hour < 18 Then
        If date1.Hour < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (date1.Hour + date1.Minute / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If date2.Hour >= 8 Then
        If date2.Hour >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = date2.Hour + date2.Minute / 60 - 8
        End If
    End If
 
    heuretravail = 10 * nbjourscomplet + nbHeuresAvant + nbHeuresApres
End Function

En gros il faudrait que lorsque je récupere les cellules contenant la date et l'heure ,il que je recupere l'heure et les minutes, que je fasse la sousctraction entre les deux cellules et que je récupere le temps écoulés entre ces deux horraires ,par contres seules les heures entre la plage 8heures -18 heures doivent compter ,et les heures faisant partie des week end et jours féries sont a exclures également


donc pour remettre un exemple concret

exemple ouverture d'un incident le 28/10/2010 à 12 heures et fermeture de celui-ci le 2/11/2010 à 9 heures

le 28/10/2010 de 12heures à 18heures il y a 6 heures

le 29 il y a 10 heures qui se passe (de 8heures à 18 heures )donc une journée

Le 30,31 c"'est le week end donc on ne calcul pas les heures

Le 01/11/2010 c'est un jour férié on ne compte pas également.


le 2/11/2010 de 8 heures à 14 heures il y a 6 heures

donc si on calcule le nombre de jours entre le 2/11/2010 et le 28/10/2010
il y a 6heures +10 heures +6 heures ce qui fait 24 heures donc

deux jours et 4 heures...Je ne vois vraiment pas comment faire cela !!!

Merci en tout cas pour ton aide =)

[ZebreLoup]

Fais attention quand tu donnes des exemples concrêts : tu parles d'abord de 9h le dernier jour, puis de 14h. De plus 10 + 6 + 6 = 22 et non 24 !

Sinon désolé, je me croyais en C# avec mon date1.Hour, c'est Hour(date1). De plus, il y avait un problème avec la fonction Work_Days de MarcelG quand il y a une heure dans la date, j'ai donc rajouté le DateValue.

Voici un code qui fonctionne :

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
Public Function HeuresTravail(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1), DateValue(date2), True) - 2
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If Hour(date1) < 18 Then
        If Hour(date1) < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (Hour(date1) + Minute(date1) / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If Hour(date2) >= 8 Then
        If Hour(date2) >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = Hour(date2) + Minute(date2) / 60 - 8
        End If
    End If
 
    HeuresTravail = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
End Function

[debutVBA]

Re =)

Il est vrai que je commence a m'y perdre lool

donc je reposte le code ici

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
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
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
Sub calculPenalites()
 
'On ouvre le classeur
Dim monClasseur As Workbook
Set monClasseur = Workbooks("Copie de abcd - Copie.xlsm")
 
'on ouvre la feuille
Dim maFeuille As Worksheet
Set maFeuille = monClasseur.Worksheets("etat")
 
'on active la feuille
monClasseur.Worksheets("etat").Activate
 
Call QuelMoisACalculer
 
End Sub
 
'cette fonction renvoit la difference entre deux dates.
Function NbJours(d1 As Date, d2 As Date) As Integer
    NbJours = DateDiff("d", d1, d2)
End Function
 
 
Function QuelMoisACalculer()
 
Dim leMois As Byte
leMois = Application.InputBox("quel est le mois que vous souhaitez calculer les pénalités", Type:=1)
 
Dim compteur As Byte
compteur = 0
 
Dim PenaliteDeCeDossier As Long
PenaliteDeCeDossier = 0
 
Dim JoursSupplementaires As Long
JoursSupplementaires = 0
 
Dim SommePenaliteDuMois As Long
SommePenaliteDuMois = 0
 
For ligne = 2 To 10
 
' on recupere le mois de la date indiqué dans la cellule
x = Month(Cells(ligne, 16).Value)
 
If x = leMois Then
 
compteur = compteur + 1
 
            'ICI CELA M'AFFICHE 12 heures or qu'il devrait y avoir
            nombH = HeuresTravail(Cells(ligne, 16).Value, Cells(ligne, 18).Value)
            MsgBox "le nombre d'heures est de " & nombH
 
            'ICI CELA M'AFFICHE ZERO
         ' NBH = HeuresTravailBisBis(Cells(ligne, 16).Value, Cells(ligne, 18).Value)
         ' MsgBox "le nombre d'heures est de " & NBH
 
' calculer la difference entre deux dates pour avoir le nombre de jour entre l'ouverture de l'intervention et sa cloture
        nbj = NombreJoursDiff(Cells(ligne, 16), Cells(ligne, 18))
 
       ' calcule du nombre d'heures entre deux dates donnés
         'nomH = HeuresTravailles(Cells(ligne, 16), Cells(ligne, 18))
       ' MsgBox " le nombre d'heures de ces deux dates est de " & nomH
 
        nbjj = nbjourouvrable(Cells(ligne, 16), Cells(ligne, 18))
      MsgBox " le nombre de jours entre la date d'ouverture de l'intervention et de sa cloture est de  " & nbjj
 
           '  Indisponibilité > = à 1jours ou 10heures = 10€
            If nbjj = 1 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10
 
            ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
            ElseIf nbjj = 2 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18
 
            ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
            ElseIf nbjj = 3 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18 + 25
 
            ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
            ElseIf nbjj > 3 Then
            JoursSupplementaires = nbj - 4 ' pour avoir le nombre de jours supplementaires
 
            PenaliteDeCeDossier = PenaliteDeCeDossier + 53 + 25 * JoursSupplementaires
 
            End If
 
SommePenaliteDuMois = SommePenaliteDuMois + PenaliteDeCeDossier
 
End If
 
Next
 
MsgBox "la penalite du mois  " & leMois & "   duquel on a souhaite calculer la penalite est de " & SommePenaliteDuMois
MsgBox "le nombre d'intervention du mois " & leMois & " est de " & compteur
 
End Function
 
Function NombreJoursDiff(d1 As Date, d2 As Date) As Integer
    NombreJoursDiff = DateDiff("d", d1, d2)
End Function
 
Function nbjourouvrable(datdeb, datfin)
If datdeb = "" Or datfin = "" Then Exit Function
 
nbjourtot = DateDiff("d", datdeb, datfin) + 1
 
For i = 1 To nbjourtot
 
  If ferie(datdeb) Then
   nbjourtot = nbjourtot - 1
  End If
 
 datdeb = DateAdd("d", 1, datdeb)
 
Next
nbjourouvrable = nbjourtot
 
End Function
 
Function ferie(Jour)
If Jour = "" Then Exit Function
Dim JJ, AA
Dim NbOr, Epacte
Dim PLune, Paques, Ascension, Pentecote
 
JJ = Day(Jour)
mm = Month(Jour)
AA = Year(Jour)
 
If JJ = 1 And mm = 1 Then ferie = True: Exit Function     '1 Janvier
If JJ = 1 And mm = 5 Then ferie = True: Exit Function     '1 Mai
If JJ = 8 And mm = 5 Then ferie = True: Exit Function     '8 Mai
If JJ = 14 And mm = 7 Then ferie = True: Exit Function   '14 Juillet
If JJ = 15 And mm = 8 Then ferie = True: Exit Function   '15 Août
If JJ = 1 And mm = 11 Then ferie = True: Exit Function   '1 Novembre
If JJ = 11 And mm = 11 Then ferie = True: Exit Function '11 Novembre
If JJ = 25 And mm = 12 Then ferie = True: Exit Function '25 Décembre
NbOr = (AA Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1
 
Paques = PLune - Weekday(PLune) + vbMonday + 7  'Paques
If JJ = Day(Paques) And mm = Month(Paques) Then ferie = True: Exit Function
 
Ascension = Paques + 38 'Ascension
If JJ = Day(Ascension) And mm = Month(Ascension) Then ferie = True: Exit Function
 
Pentecote = Ascension + 11 'Pentecote
If JJ = Day(Pentecote) And mm = Month(Pentecote) Then ferie = True: Exit Function
ferie = False
Dim numjour
numjour = Weekday(Jour, vbMonday)    'fixe à 6 et 7 la valeur du samedi & dimanche
If numjour = 6 Or numjour = 7 Then ferie = True: Exit Function
End Function
 
 
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 IIf(bAvecJFerie, Not EstFerie(dt), True) 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
 
 
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function
 
Function calc(Cells)
 
Dim lib_date1 As Range, lib_date2 As Range
Dim date_1 As Date, date_2 As Date
Dim heure_1 As Long, Heure_2 As Long
 
        'Set lib_date1 =
        Set lib_date2 = .Range("A2")
 
'Calcul des Serial de chaque date
date_1 = DateSerial(Year(lib_date1), Month(lib_date1), Day(lib_date1))
date_2 = DateSerial(Year(lib_date2), Month(lib_date2), Day(lib_date2))
 
'Calcul des heures de chaque date
heure_1 = Hour(lib_date1)
Heure_2 = Hour(lib_date2)
 
'Calcul de la durée effective
MsgBox "Temps " & HeuresTravail(date_1, heure_1, date_2, Heure_2)
 
'Réinitialisation des variables
Set ib_date1 = Nothing
Set ib_date2 = Nothing
 
End Function
 
 
Public Function HeuresTravail(date1 As Date, date2 As Date)
'36000 = 10 heures * 60 minutes * 60 secondes
 
Dim heure_1 As Variant
 
Dim Heure_2 As Variant
 
'Calcul des heures de chaque date
heure1 = Hour(date1)
heure2 = Hour(date2)
 
'Calcul de la durée effective
'MsgBox "Temps " & HeuresTravail(date_1, heure_1, date_2, Heure_2)
 
diff = ((Work_Days(date1, date2) - 1) * 10 - (heure1 - heure2))
HeuresTravail = diff
 
End Function
 
 
 Function HeuresTravailBisBis(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1), DateValue(date2), True) - 2
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If Hour(date1) < 18 Then
        If Hour(date1) < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (Hour(date1) + Minute(date1) / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If Hour(date2) >= 8 Then
        If Hour(date2) >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = Hour(date2) + Minute(date2) / 60 - 8
        End If
    End If
 
    HeuresT = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
End Function

En essayant une fonction que j'ai récupéré en la modifiant un peu cela m'affiche 12 heures or que cela me devrai m'afficher 12 heures et 23 minutes

le calcul se fait entre le 28/10/2010 17 heures 07 minutes et
le 02/11/2010 9heures 30

le 28/10/2010 de 17heures 07 à 18heures il y a 53 minutes
le 28/10/2010 il y a 10 heures (de 8 heures à 18heures)

le 30,31 on ne compte pas c'est week end
le 1/11/2010 on ne compte pas c'est ferie
le 2 /11/2010 fermeture à 9heures 30 donc de 8 heures à 9 heures 30 il y a une heures et demi

donc on va essayer d'etre bon en math lool
53 minutes + 10 heures + 1heures 30 cela fait 12heures et 23 minutes =)
la fonction concerné

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Function HeuresTravail(date1 As Date, date2 As Date)
 
'Calcul des heures de chaque date
heure1 = Hour(date1)
heure2 = Hour(date2)
 
diff = ((Work_Days(date1, date2) - 1) * 10 - (heure1 - heure2))
HeuresTravail = diff
 
End Function

En utilisant la fonction que tu m'as proposé cela m'affiche Zero

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
Public Function HeuresTravail(date1 As Date, date2 As Date) As Double
    Dim nbJoursComplets As Long
    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(date1), DateValue(date2), True) - 2
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If Hour(date1) < 18 Then
        If Hour(date1) < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (Hour(date1) + Minute(date1) / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If Hour(date2) >= 8 Then
        If Hour(date2) >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = Hour(date2) + Minute(date2) / 60 - 8
        End If
    End If
 
    HeuresT = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
End Function

Merci en tout cas

[ZebreLoup]

Quand j'utilises ma fonction, ça me donne 12.38333.
C'est donc plus un problème d'affichage. Si tu prends mon résultat que tu divises par 24 et que tu mets au format hh:mm, tu as bien 12:23.

Après ça dépends comme tu veux procéder. Vu que pour toi une journée vaut 10h, il faudrait diviser par 10, la partie entière représentera le nombre de jours et il faudrait convertir la partie décimal pour avoir l'heure.

avec le code suivant, ça donne une réponse en toute lettre :

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
Public Function HeuresTravail(date1 As Date, date2 As Date) As String
    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
 
    'Le nombre de jours ouvrés total entre date1 à minuit "du soir" et date2 à minuit "du matin" !
    nbJoursComplets = Work_Days(DateValue(date1), DateValue(date2), True) - 2
 
    'Le nombre d'heures travaillées entre date1 et date1 à 18h
    If Hour(date1) < 18 Then
        If Hour(date1) < 8 Then
            nbHeuresAvant = 10
        Else
            nbHeuresAvant = 18 - (Hour(date1) + Minute(date1) / 60)
        End If
    End If
 
    'Le nombre d'heures travaillées entre date2 à 8h et date2
    If Hour(date2) >= 8 Then
        If Hour(date2) >= 18 Then
            nbHeuresApres = 10
        Else
            nbHeuresApres = Hour(date2) + Minute(date2) / 60 - 8
        End If
    End If
 
    nbHeuresTotal = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
 
    nbJours = Int(nbHeuresTotal / 10)
    heuresRestantes = nbHeuresTotal - nbJours * 10
    minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
 
    HeuresTravail = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
 
End Function

[debutVBA]

re,

j'ai essayé cette recette de cuisine mais visiblement cela ne fonctionne pas...

Code :

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

1
2
3
4
5
6
7
8
            ' on divise par 24
             nombH = nombH \ 24
            ' et on met au format hh:mm pour obtenir le format heure
 
            heure = Fix(nombH)
            Minute = ((A - heure) / 100) * 60
            Resultat = heure & ":" & Minute
            MsgBox "le nombre d'heures est de " & Resultat

Il faudrait faire comment pour convertir en heure minutes ?

Et auquel cas une fois que cela est convertit par exemple 12:23 et 13 : 46
est ce que cela va me donner 26 : 09 ???

Merci à toi

En effet,en utilisant ta fonction cela fonctionne mais ensuite ,je dois donc utiliser nb (indiquer dans le code ci dessous et selon le cas décrit dans les conditionnelles appliquer les sanctions.

dans ma 4 eme condition ,il va falloir aussi gérer les jours supplementaires ,
si admettons je suis dans dans un cas > 40 heures

par exemple il y a 46 heures et 10 minutes ,il y aura qu'un jour supplementaire

donc pour le 4 eme cas faut que je recupere seulement la partie entiere de nb,
si il y a 56 heures je recupere donc 50 heures et il y a donc que deux jours supplementaires..

trop dur pour moi

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
              ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
            ElseIf nb > 40 Then
            JoursSupplementaires = nombH - 4 ' pour avoir le nombre de jours supplementaires
 
  nb = HeuresT(Cells(ligne, 16).Value, Cells(ligne, 18).Value)
MsgBox " Pour le dossier concernant le num REPA  " & Cells(ligne, 1).Value & "envoyé le " & Cells(ligne, 16).Value & " et fermé le  : " & Cells(ligne, 16).Value & " il s'est passé " & nb
 
           '  Indisponibilité > = à 1jours ou 10heures = 10€
            If nb >= 10 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10
 
            ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
            ElseIf nb >= 20 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18
 
            ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
            ElseIf nb >= 30 Then
            PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18 + 25            
 
            ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
            ElseIf nb > 40 Then
            JoursSupplementaires = nombH - 4 ' pour avoir le nombre de jours supplementaires
 
            PenaliteDeCeDossier = PenaliteDeCeDossier + 53 + 25 * JoursSupplementaires
 
            End If
 
SommePenaliteDuMois = SommePenaliteDuMois + PenaliteDeCeDossier
 
End If

[ZebreLoup]

Ma "cuisine" ne servait qu'à l'affichage, ça n'avait aucune valeur pour les calculs, en effet, pour Excel, une journée ne fait pas 10h !

C'est pour ça qu'il faut que tu utilises le résultats de mon avant dernier code, avant l'affichage en toute lettres. Cela te donnais un nombre d'heures (les minutes après la virgule repassées en base 10 et non 60). Tu le divises par 10 afin d'avoir un nombre de jours pour ton test, c'est très simple, je ne vois pas où est le souci.

[debutVBA]

RE zebreloup,

c'est ce que j'ai effectué mais suis pas convaincu au niveau du resultat

voici d'ailleurs le code final

les dates de tests utilisés sont :

Date début
28/10/2011 17:07
07/11/2011 15:58
07/11/2011 17:49
10/11/2011 15:43
17/11/2011 15:55
18/11/2011 10:07
21/11/2011 16:46
22/11/2011 09:46
25/11/2011 16:15


Date fin

02/11/2011 09:30
08/11/2011 16:57
08/11/2011 17:09
14/11/2011 17:20
18/11/2011 11:30
24/11/2011 11:00
22/11/2011 11:41
24/11/2011 12:00
28/11/2011 10:03

donc lorsque je calcul pour les sanctions du mois de novembre par exemple
en se basant sur ceci

' Indisponibilité > = à 1jours ou 10heures = 10€

' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€

' Indisponibilité entre 2 et 3jours => 10€ +18€ + 25€ =53€

' Indisponibilité supérieur à 3jours => 53€ + 25€/jour supplémentaire

j'obtiens pour le mois de novembre 200 or que je devrais obtenir moins !!!
je vois pas ou est la coquille !

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
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
Sub calculPE()
 
'On ouvre le classeur
Dim monClasseur As Workbook
Set monClasseur = Workbooks("Copie de abcd - Copie.xlsm")
 
'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 ferie(Jour)
If Jour = "" Then Exit Function
Dim JJ, AA
Dim NbOr, Epacte
Dim PLune, Paques, Ascension, Pentecote
 
JJ = Day(Jour)
mm = Month(Jour)
AA = Year(Jour)
 
If JJ = 1 And mm = 1 Then ferie = True: Exit Function     '1 Janvier
If JJ = 1 And mm = 5 Then ferie = True: Exit Function     '1 Mai
If JJ = 8 And mm = 5 Then ferie = True: Exit Function     '8 Mai
If JJ = 14 And mm = 7 Then ferie = True: Exit Function    '14 Juillet
If JJ = 15 And mm = 8 Then ferie = True: Exit Function    '15 Août
If JJ = 1 And mm = 11 Then ferie = True: Exit Function    '1 Novembre
If JJ = 11 And mm = 11 Then ferie = True: Exit Function   '11 Novembre
If JJ = 25 And mm = 12 Then ferie = True: Exit Function   '25 Décembre
 
NbOr = (AA Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1
 
Paques = PLune - Weekday(PLune) + vbMonday + 7  'Paques
If JJ = Day(Paques) And mm = Month(Paques) Then ferie = True: Exit Function
 
Ascension = Paques + 38 'Ascension
If JJ = Day(Ascension) And mm = Month(Ascension) Then ferie = True: Exit Function
 
Pentecote = Ascension + 11 'Pentecote
If JJ = Day(Pentecote) And mm = Month(Pentecote) Then ferie = True: Exit Function
ferie = False
Dim numjour
numjour = Weekday(Jour, vbMonday)    'fixe à 6 et 7 la valeur du samedi & dimanche
If numjour = 6 Or numjour = 7 Then ferie = True: Exit Function
End Function
 
 
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 IIf(bAvecJFerie, Not EstFerie(dt), True) 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
 
 Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
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 Byte
    leMois = Application.InputBox("quel est le mois que vous souhaitez calculer les pénalités", Type:=1)
    Dim compteur As Byte
    compteur = 0
    Dim PenaliteDeCeDossier As Long
    PenaliteDeCeDossier = 0
    Dim JoursSupplementaires As Long
    JoursSupplementaires = 0
    Dim SommePenaliteDuMois As Long
    SommePenaliteDuMois = 0
 
For ligne = 2 To 10
 
' on recupere le mois de la date indiqué dans la cellule
x = Month(Cells(ligne, 16).Value)
 
                '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
 
                If x = leMois Then
 
                ' ce compteur servira seulement à compter 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, 16).Value), DateValue(Cells(ligne, 18).Value), True) - 2
 
           'Le nombre d'heures travaillées entre date1 et date1 à 18h
           If Hour(Cells(ligne, 16).Value) < 18 Then
 
               If Hour(Cells(ligne, 16).Value) < 8 Then
                   nbHeuresAvant = 10
               Else
                   nbHeuresAvant = 18 - (Hour(Cells(ligne, 16).Value) + Minute(Cells(ligne, 16).Value) / 60)
               End If
 
           End If
 
        'Le nombre d'heures travaillées entre date2 à 8h et date2
        If Hour(Cells(ligne, 18).Value) >= 8 Then
 
                If Hour(Cells(ligne, 18).Value) >= 18 Then
                    nbHeuresApres = 10
                Else
                    nbHeuresApres = Hour(Cells(ligne, 18).Value) + Minute(Cells(ligne, 18).Value) / 60 - 8
            End If
 
        End If
 
        nbHeuresTotal = 10 * nbJoursComplets + nbHeuresAvant + nbHeuresApres
 
        nbJours = Int(nbHeuresTotal / 10)
        heuresRestantes = nbHeuresTotal - nbJours * 10
        minutesRestantes = (heuresRestantes - Int(heuresRestantes)) * 60
 
        HeuresT = nbJours & " jours, " & Int(heuresRestantes) & " heures et " & minutesRestantes & " minutes"
 
               'Mettre Cette info a mettre dans un fichier texte.
    ' nb = HeuresT(Cells(ligne, 16).Value, Cells(ligne, 18).Value)
MsgBox " Pour le dossier concernant le num REPA  " & Cells(ligne, 1).Value & "envoyé le " & Cells(ligne, 16).Value & " et fermé le  : " & Cells(ligne, 16).Value & " il s'est passé " & HeuresT
 
                   '  Indisponibilité > = à 1jours ou 10heures = 10€
                    If nbJours >= 1 Then
                    PenaliteDeCeDossier = PenaliteDeCeDossier + 10
 
                    ' Indisponibilité entre 1 et 2 jours => 10€ +18 € = 28€
                    ElseIf nbJours >= 2 Then
                    PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18
 
                    ' Indisponibilité entre 2  et  3jours => 10€ +18€ + 25€  =53€
                    ElseIf nbJours >= 3 Then
                    PenaliteDeCeDossier = PenaliteDeCeDossier + 10 + 18 + 25
 
                    ' Indisponibilité supérieur à 3jours  => 53€ + 25€/jour supplémentaire
                    ElseIf nbJours > 4 Then
                    JoursSupplementaires = nbJours - 4 ' pour avoir le nombre de jours supplementaires
 
                    PenaliteDeCeDossier = PenaliteDeCeDossier + 53 + 25 * JoursSupplementaires
 
                    End If
 
    SommePenaliteDuMois = SommePenaliteDuMois + PenaliteDeCeDossier
 
    End If
 
    Next
 
    MsgBox "la penalite du mois  " & leMois & "   duquel on a souhaite calculer la penalite est de " & SommePenaliteDuMois
    MsgBox "le nombre d'intervention du mois " & leMois & " est de " & compteur
 
    End Function