Discussion :

[mr.t]

Bonjour,

Je souhaiterais créer une fonction prenant en paramètre 2 dates et permettant de calculer leur différence selon les jours ouvrés en sachant qu'une semaine compte 5 jours et une journée compte 8 heures. Le résultat doit être de la forme jj : hh : mm. Le problème est que je ne sais pas trop comment m'y prendre. J'ai essayé de bidouiller avec les fonction Access prédéfinies mais celles-ci fonctionnent sur les bases traditionnelles (journée de 24h et semaines de 7 jours). Comment faire?

Merci d'avance!

[random]

d'abord il faut clarifier le problème
chacune de tes dates est de la forme
jj mm aaaa hh mm ss représentée par un nombre
leur différence sera aussi un nombre de même type
1° problème comment ajuster les heures
a par quantité de jours * 8 ou bien faut il tenir compte des heures ouvrées

ainsi si je donne comme date 15/02/2006 00:01 15/02/2006 23:59 tu veux combien d'heures 8 ou 23:59

de même je commence un travil aujourdhui à 16 heures pour le finir demain à 10: tu veux quoi ? en résultat

quand tu auras clarifié ce point je pourrais te répondre (peut être)

[pc75]

Bonjour,

Pour faire shématique (c'est du VB et pas testé, c'est pour l'idée)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Deb = 01/01/2006
Fin = 31/01/2006
 
Duree = 0
do while DateDiff("d", Fin, Deb) <> 0
   if WeekDay(Deb) = vbMonday or WeekDay(Deb) = vbTuesday ..... then
      Duree = Duree + 5
   end if
   Deb = DateAdd("d", 1 , Deb)
loop

[random]

et les jours fériès ?????

[mr.t]

Alors pour commencer,

si je donne comme date 15/02/2006 00:01 15/02/2006 23:59 tu veux combien d'heures 8 ou 23:59

Il faudrait obtenir 8h! Il faut donc uniquement tenir compte des heures ouvrées qui sont 8h-12h et 13h-17h.

je commence un travil aujourdhui à 16 heures pour le finir demain à 10: tu veux quoi ? en résultat

Le résultat devrait donc donner 3h.

et les jours fériès ?????

Tout à fait, il faudrait en plus tenir compte des jours fériés...

Merci de votre aide!

[mr.t]

SVP, personne n'aurait une idée?

C'est assez urgent!

Il faudrait au minimum, une fonction qui calcule les jours ouvrés dans un intervalle de dates en tenant compte des jours fériés (celle présente dans la faq ne fonctionnant pas quand la date de fin est dans un mois différent de la date de début).

Merci!

[Kloun]

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
Function calculDelai(pDat_Deb As Date, pDat_Fin As Date) As Integer
' Calcul un nombre de jour ouvré entre 2 date
Dim iInt_NbJours As Integer
Dim iInt_NbJoursOuvres As Integer
Dim iInt_NbSemaines As Integer
Dim iInt_NbJoursOuvresRest As Integer
Dim iDat_JoursFeries() As Date
Dim iInt_Compteur As Integer
 
    ReDim iDat_JoursFeries(7)
    iDat_JoursFeries(0) = "17/04/2006"
    iDat_JoursFeries(1) = "01/05/2006"
    iDat_JoursFeries(2) = "08/05/2006"
    iDat_JoursFeries(3) = "25/05/2006"
    iDat_JoursFeries(4) = "14/07/2006"
    iDat_JoursFeries(5) = "15/08/2006"
    iDat_JoursFeries(6) = "01/11/2006"
    iDat_JoursFeries(7) = "25/12/2006"
 
    iInt_NbJours = DateDiff("D", pDat_Deb, pDat_Fin)
 
    iInt_NbSemaines = Int(iInt_NbJours / 7)
    iInt_NbJoursOuvresRest = iInt_NbJours Mod 7
    If WeekDay(pDat_Fin) < WeekDay(pDat_Deb) Then
        ' il y a un WE supplémentaire
        iInt_NbJoursOuvresRest = iInt_NbJoursOuvresRest - 2
    End If
    iInt_NbJoursOuvres = iInt_NbSemaines * 5 + iInt_NbJoursOuvresRest
    ' On gère les jours fériés
    For iInt_Compteur = 0 To 7
        If pDat_Deb <= iDat_JoursFeries(iInt_Compteur) And pDat_Fin > iDat_JoursFeries(iInt_Compteur) Then
            iInt_NbJoursOuvres = iInt_NbJoursOuvres - 1
        End If
    Next
    calculDelai = iInt_NbJoursOuvres
 
End Function

Ca ne tient compte que de 2006, mais ça peut être modifié

[pc75]

Re,

Ca te convient ?

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
 
Do while true
   Debut = InputBox("Entrer la date de début (jj/mm/aaaa)", "Mes vacances !", "")
   if Debut = "" then
      WScript.Quit()
   elseif not IsDate(Debut) then
      Resultat = MsgBox ("La date de début est invalide.", vbCritical, "Mes vacances !")
      OK = false
   end if
 
   Fin = InputBox("Entrer la date de fin (jj/mm/aaaa)", "Mes vacances !", "")
   if Fin = "" then
      WScript.Quit()
   elseif not IsDate(Fin) then
      Resultat = MsgBox ("La date de fin est invalide.", vbCritical, "Mes vacances !")
      OK = false
   end if
 
   OK = true
 
   if OK = true then
      Deb = Debut
      Do while DateDiff("d", Deb, Fin) >= 0
if IsFerie(Deb) then
   NbFeries = NbFeries + 1
end if
         if Not IsFerie(Deb) and WeekDay(Deb, vbMonday) <> 6 and WeekDay(Deb, vbMonday) <> 7 then
            NbJours = NbJours + 1
         end if
         Deb = DateAdd("d", 1, Deb)
      Loop
   end if
'   Resultat = MsgBox ("La période du " & Debut & " au " & Fin & " comprend " & NbJours _
'             & " jours ouvrés." & chr(10) & chr(10) & "(Les éventuels ponts ne sont pas pris en compte.)" _
'             , vbInformation, "Mes vacances !")
msgbox NbFeries
loop
 
Function IsFerie(LeJour)
	Annee = Year(LeJour)
	Paques = fPaques(Annee) 'Cherche le jour de Pâques
 
	LunPaq = cStr(DateAdd("d", 1, Paques)) 'En déduit les jours fériés mobiles
 
	Ascension = cStr(DateAdd("d", 39, Paques))
 
	LunPent = cStr(DateAdd("d", 50, Paques))
 
	PremierJanvier = "01/01/" & Annee
	PremierMai = "01/05/" & Annee
	HuitMai = "08/05/" & Annee
	QuatorzeJuillet = "14/07/" & Annee
	QuinzeAout = "15/08/" & Annee
	PremierNovembre = "01/11/" & Annee
	OnzeNovembre = "11/11/" & Annee
	Noel = "25/12/" & Annee
 
        StrJour = cStr(LeJour)
	if StrJour = LunPaq or StrJour = Ascension or (StrJour = LunPent and Year(LunPent) < 2005) _
	or StrJour = PremierJanvier or StrJour = PremierMai or StrJour = HuitMai _
	or StrJour = QuatorzeJuillet or StrJour = QuinzeAout or StrJour = OnzeNovembre _
	or StrJour = PremierNovembre or StrJour = Noel then
		IsFerie = true
	else
		IsFerie = false
	end if
End Function
 
Function fPaques(An)
	'Calcule le jour de Pâques en fonction de l'année
 
	a  = An  Mod 19
	b  = An  \ 100
	c  = An  Mod 100
	d  = b  \ 4
	e  = b  Mod 4
	f  = (b  + 8) \ 25
	g  = (b  - f  + 1) \ 3
	h  = (19 * a  + b  - d  - g  + 15) Mod 30
	i  = c  \ 4
	k  = c  Mod 4
	l  = (32 + 2 * e  + 2 * i  - h  - k ) Mod 7
	m  = (a  + 11 * h  + 22 * l ) \ 451
	n  = (h  + l  - 7 * m  + 114) \ 31
	p  = (h  + l  - 7 * m  + 114) Mod 31
	fPaques = DateSerial(An , n , p  + 1)
End Function

[cafeine]

Hello,

j'ai ça qui traine dans ma base à outils (c'est de la vieille programmation, maintenant je sais faire des trucs plus propres :p ) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Function DonneJoursOuvresIntervalle(ByVal dt0 As Date, ByVal dt1 As Date) As Integer
Dim i As Date
 
DonneJoursOuvresIntervalle = 0
 
For i = dt0 To dt1
    'Debug.Print i, DonneJour(i, "ouvré")
    If Len(DonneJour(i, "ouvré")) = 0 Then
        DonneJoursOuvresIntervalle = DonneJoursOuvresIntervalle + 1
    End If
Next i
 
End Function

qui marche avec ...

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
Function DonneJour(ByVal dtDate As Date, ByVal TypeJour As String) As String
 
        Dim A As Integer, M As Integer, d As Integer
        Dim tmpDate As Date
 
        A = Year(dtDate): M = Month(dtDate): d = Day(dtDate)
 
Select Case TypeJour
 
    Case "ouvrable"
        If WeekDay(dtDate, vbMonday) > 5 Then
                DonneJour = "week-end"
                Exit Function
        End If
 
    Case "ouvré"
 
        If M = 1 And d = 1 Then
                DonneJour = "1er Janvier - Jour de l'An"
                Exit Function
        ElseIf M = 5 And d = 1 Then
                DonneJour = "1er Mai - Fête du Travail"
                Exit Function
        ElseIf M = 5 And d = 8 Then
                DonneJour = "8 Mai - Victoire 1945"
                Exit Function
        ElseIf M = 7 And d = 14 Then
                DonneJour = "14 Juillet - Fête nationale"
                Exit Function
        ElseIf M = 8 And d = 15 Then
                DonneJour = "15 Août - Assomption"
                Exit Function
        ElseIf M = 11 And d = 1 Then
                DonneJour = "1er Novembre - Toussaint"
                Exit Function
        ElseIf M = 11 And d = 11 Then
                DonneJour = "11 Novembre - Armistice 1918"
                Exit Function
        ElseIf M = 12 And d = 25 Then
                DonneJour = "25 Décembre - Noël"
                Exit Function
        ElseIf WeekDay(dtDate, vbMonday) > 5 Then
                DonneJour = Format(dtDate, "dddd")
                Exit Function
        Else
 
                tmpDate = fLundiPaques(A)
 
                If dtDate = tmpDate Then
                        DonneJour = "Lundi de Pâques"
                        Exit Function
                ElseIf dtDate = tmpDate + 38 Then
                        DonneJour = "Jeudi de l'Ascension"
                        Exit Function
                ElseIf dtDate = tmpDate + 49 Then
                        DonneJour = "Lundi de Pentecôte"
                        Exit Function
                End If
 
        End If
 
    End Select
 
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
 
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

edit : mince, je suis arrivé après tout le monde

[Kloun]

Ben si avec tout ça il trouve pas son bonheur, c'est à désespérer.
Moi je vais récupérer la fonction qui donne les jours fériés.

M'enfin, faudra le rajeunir, parce que le lundi de Pentecôte, c'est mort ...

[r@phy]

Je viens juste de terminer un truc du même type, et un petit conseil si je peux me permettre... : si cette fonction est liée pour quelque raison que ce soit à des employés d'une entreprise, n'oublie pas qu'ils peuvent également poser des vacances !

Je me suis fait eu, et j'ai honte

[random]

j'ai aussi mes fonctions de jours ouvrés que je n'aurais pas l'outrecuidance
de proposer ici

mais pour revenir à la démarche pertinente de r@phy

une des meilleures solutions est de créer une table des jours fériès
qui reprendra le calendrier de l'entreprise

ainsi si l'entreprise est fermée le xx pour la féria ou le yy pour l'anniversaire du patron ou le zz pour le changement du siège on
peut facilement intervenir

[mr.t]

Merci à vous tous de votre aide.
Je pense que je m'en sortirai avec ça!