Re : Calcul de date de fin à partir d'une date de début, d'une durée et contraintes h
Re Job,
Et merci encore pour votre aide persistante pour la résolution de mes problèmes.
Je ne comprends pas encore le VBA mais j'y travaille... 😀
Une fonction SUB, je comprends la une sous fonction ou sous partie de programme, ceci veut dire que je dois insérer les commandes comme ceci ?!
Option Explicit
Function Datefin(deb As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, dur As Long, minutes As Long, n As Long, t As Date, dat As Long, test As Boolean
Application.Volatile 'permet le recalcul de la fonction
Application.Calculation = xlManual
With Sheets("Variables")
t1 = .[E1]
t2 = .[E2]
t3 = .[E3]
t4 = .[E4]
End With
dur = Round(duree * 1440) 'conversion en minutes
Datefin = deb 'au cas où duree = 0
While minutes < dur
n = n + 1
Datefin = deb + n / 1440
t = TimeValue(Datefin)
If Int(CDec(Datefin)) > dat Then
dat = Int(CDec(Datefin))
test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
End If
If test And (t > t1 And t <= t2 Or t > t3 And t <= t4) Then minutes = minutes + 1
Wend
Application.Calculation = xlAutomatic
End Function
Function DateDeb(fin As Date, duree As Date) As Date
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, dur As Long, dat As Long, test As Boolean, minutes As Long, n As Long, t As Date
Application.Volatile 'permet le recalcul de la fonction
Application.Calculation = xlManual
With Sheets("Variables")
t1 = .[E1]
t2 = .[E2]
t3 = .[E3]
t4 = .[E4]
End With
dur = Round(duree * 1440) 'conversion en minutes
dat = Int(CDec(fin)) 'initialisation indispensable ici
test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
DateDeb = fin 'au cas où duree = 0
While minutes < dur
n = n + 1
DateDeb = fin - n / 1440
t = TimeValue(DateDeb)
If Int(CDec(DateDeb)) < dat Then
dat = Int(CDec(DateDeb))
test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
End If
If test And (t >= t1 And t < t2 Or t >= t3 And t < t4) Then minutes = minutes + 1
Wend
Application.Calculation = xlAutomatic
End Function
Function ChargeSem(deb As Date, duree As Date, semaine As Integer) As Variant
Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date, sem As Integer, dur As Long
Dim Datefin As Date, minutes As Long, n As Long, t As Date, dat As Long, test As Boolean
Application.Volatile 'permet le recalcul de la fonction
Application.Calculation = xlManual
With Sheets("Variables")
t1 = .[E1]
t2 = .[E2]
t3 = .[E3]
t4 = .[E4]
End With
If Weekday(deb, 2) > 1 Then sem = 1
dur = Round(duree * 1440) 'conversion en minutes
Do While minutes < dur
n = n + 1
Datefin = deb + n / 1440
t = TimeValue(Datefin)
If Int(CDec(Datefin)) > dat Then
dat = Int(CDec(Datefin))
test = Weekday(dat, 2) < 6 And IsError(Application.Match(dat, [Feries], 0))
If Weekday(dat, 2) = 1 Then sem = sem + 1: If sem > semaine Then Exit Do
End If
If test And (t > t1 And t <= t2 Or t > t3 And t <= t4) Then
minutes = minutes + 1
If sem = semaine Then ChargeSem = ChargeSem + 1
End If
Loop
If ChargeSem Then ChargeSem = ChargeSem / 1440 Else ChargeSem = "" 'pour ne rien afficher si charge nulle
Application.Calculation = xlAutomatic
End Function
😕
Ah oui j'oubliai, j'ai déjà passé le fichier en calcul manuel et sans calcul à l'enregistrement...
A+
