Les délais sont calculés par le bouton et la fonction VBA.
Ensuite il ne faut pas tenir compte des jours ouvrés, un calcule simplement de date a date. La fonction de calcul délais est celle mise ci avant...
Public Sub Calcul_délai(NtypeSuivi)
On Error GoTo err_delai
Dim db As Database
Dim rst As Recordset
Dim rst2 As Recordset
Dim cumul_arrivée As Long
Dim indicjour As Byte
Dim cumul_jour As Long
Dim qté_à_traiter As Long
Dim qté_traitée As Long
Dim strsql As String
Dim date_début As Date
Dim stk_initial As Integer
Dim indic_fin As Byte
' == ctrl
strsql = "SELECT Tdonnées.NTypeSuivi, Tdonnées.Stock_depart, Tdonnées.Stock_fin"
strsql = strsql & " FROM Tdonnées"
strsql = strsql & " WHERE (((Tdonnées.NTypeSuivi)=" & NtypeSuivi & ") AND ((Tdonnées.Stock_depart)<0)) OR (((Tdonnées.NTypeSuivi)=" & NtypeSuivi & ") AND ((Tdonnées.Stock_fin)<0));"
Set db = CurrentDb
Set rst = db.OpenRecordset(strsql)
If rst.RecordCount > 0 Then
MsgBox "Stocks négatifs impossibles." & vbCrLf & "Veuillez corriger les arrivées et/ou les quantités traitées." & vbCrLf & vbCrLf & "Les délais n'ont pas été recalculés.", 48, "Erreur"
Set db = Nothing
Exit Sub
End If
date_début = DLookup("dtfige", "TTypeSuivi", "NTypeSuivi=" & NtypeSuivi)
stk_initial = DLookup("StkDépart", "TTypeSuivi", "NTypeSuivi=" & NtypeSuivi)
strsql = "SELECT TDonnées.Dte, TDonnées.Arrivée, TDonnées.Stock_depart, TDonnées.Stock_fin, TDonnées.Traité, TDonnées.Delai"
strsql = strsql & " FROM TDonnées"
strsql = strsql & " WHERE (((TDonnées.Dte) >= #" & Format(date_début, "MM/DD/YYYY") & "# And (TDonnées.Dte) < Date()) and ((tdonnées.ntypesuivi) = " & NtypeSuivi & "))"
strsql = strsql & " ORDER BY TDonnées.Dte DESC;"
Set rst = db.OpenRecordset(strsql)
rst.MoveFirst
Do Until rst.EOF
Début:
If rst!Traité = 0 Then
rst.Edit
rst!Delai = 0
rst.Update
rst.MoveNext
If rst.EOF Then
Set db = Nothing
Exit Sub
End If
GoTo Début
End If
strsql = "SELECT TDonnées.Dte, TDonnées.Arrivée, TDonnées.Stock_depart, TDonnées.Stock_fin, TDonnées.Traité"
strsql = strsql & " FROM TDonnées"
strsql = strsql & " WHERE (((TDonnées.Dte) <= #" & Format(rst!Dte, "MM/DD/YYYY") & "#) and tdonnées.ntypesuivi = " & NtypeSuivi & ")"
strsql = strsql & " ORDER BY TDonnées.Dte DESC;"
Set rst2 = db.OpenRecordset(strsql)
rst2.MoveFirst
cumul_arrivée = 0
indicjour = 0
Do Until cumul_arrivée >= rst!Stock_depart
If rst2.EOF Then
cumul_arrivée = cumul_arrivée + stk_initial
indic_fin = 1
Else
cumul_arrivée = cumul_arrivée + rst2!Arrivée
indicjour = indicjour + 1
rst2.MoveNext
End If
Loop
rst2.MovePrevious
qté_traitée = 0
cumul_jour = 0
If indic_fin = 0 Then
qté_à_traiter = (rst2!Arrivée - (cumul_arrivée - rst!Stock_depart))
Else
qté_à_traiter = (rst2!Arrivée + stk_initial - (cumul_arrivée - rst!Stock_depart))
End If
If qté_à_traiter >= rst!Traité Then
qté_à_traiter = rst!Traité
cumul_jour = cumul_jour + (indicjour * qté_à_traiter)
If cumul_jour <= 0 Then
MsgBox "hhh"
End If
qté_traitée = rst!Traité
End If
Do Until qté_traitée >= rst!Traité
cumul_jour = cumul_jour + (indicjour * qté_à_traiter)
indicjour = indicjour - 1
qté_traitée = qté_traitée + qté_à_traiter
If indicjour > 0 Then
rst2.MovePrevious
End If
If rst!Traité - qté_traitée >= rst2!Arrivée Then
qté_à_traiter = rst2!Arrivée
Else
qté_à_traiter = rst!Traité - qté_traitée
End If
Loop
rst.Edit
rst!Delai = cumul_jour / rst!Traité
rst.Update
rst.MoveNext
Loop
Set db = Nothing
Exit Sub
err_delai:
If Err = 3021 Then
MsgBox "Impossible de calculer le délai du " & rst!Dte & vbCrLf & "Vous devez saisir au moins " & rst!Stock_depart & " en arrivée sur ce jour et/ou les jours précédents.", 48
Set db = Nothing
Exit Sub
Else
MsgBox Err.Description, , Err
End If
Exit Sub
End Sub