Discussion :

[Gabrieel]

Bonjour,

j'essaie de déterminer une date de livraison maximale (DateMax) elle est la "somme" de la date de mise a dispo de la marchandise (dDateMAD) et du delai maxi (dDelai) et evidement on tiens compte des jours férié et des Week End dans le calcul

j'ai donc rediger ce code:

Code :

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

1
2
3
4
5
6
7
8
9
 
Function DateMax(ByVal dDateMAD As Date, dDelai As Long) As Date
    Dim dDateMaxTmp As Date      
    dDateMaxTmp = CDate(Val(dDelai) + CDate(dDateMAD))            
    Do While DatePart("w", dDateMaxTmp, 0) = 6 Or DatePart("w", dDateMaxTmp, 0) = 7 Or EstFerie(dDateMaxTmp)
        dDateMaxTmp = dDateMaxTmp + 1
    Loop
    DateMax = dDateMaxTmp
End Function

je fais un test avec le 01/10/2015 avec un délai de 8 jours, normalement je devrais avoir en retour le 13 ou le 12 a la limite, mais lui me donne le 09/10

Est ce que vous voyez l'erreur que j'ai faite dans mon code?

merci de votre aide

Bien cordialement,
G.

[3ug3n]

Bonjour Gabriel,
Vous traitez l'échéance ("Do While...") et non le délai : le 9 octobre est bien un jour ouvré, par conséquent votre code n'apporte aucune correction.
En revanche, si vous incluez les we/jours fériés dans votre délai, vous obtiendrez le résultat escompté.

PS : Ce lien vous retourne le 13 octobre, mais traite les jours fériés différemment.

[Gabrieel]

Bonjour Gabriel,
Vous traitez l'échéance ("Do While...") et non le délai : le 9 octobre est bien un jour ouvré, par conséquent votre code n'apporte aucune correction.
En revanche, si vous incluez les we/jours fériés dans votre délai, vous obtiendrez le résultat escompté.

PS : Ce lien vous retourne le 13 octobre, mais traite les jours fériés différemment.

Bonjour,

merci de t'être arreter sur mon poste Eugene, je me suis rendu compte de mon erreur dans les bouchons hier: le code marchait si l'echeance tombait sur du férié ou du week end mais si il en sautait il ne le traitait pas!

je vais regarder le code que tu m'as passé. encore merci

Bien cordialement,
G.

[Gabrieel]

Ok, c'est reglé grace au code que tu m'as passé je l'ai un peu adapté pour les fériés

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
' ********* Code Start **************
'
' Modified from code in
' "Visual Basic Language Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 2000; Sybex, Inc. All rights reserved.
'
 
Public Function dhAddWorkDaysA(lngDays As Long, _
Optional dtmDate As Date = 0, _
Optional adtmDates As Variant) As Date
    ' Add the specified number of work days to the
    ' specified date.
 
    ' Modified from code in
    ' "Visual Basic Language Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 2000; Sybex, Inc. All rights reserved.
 
    ' In:
    '   lngDays:
    '       Number of work days to add to the start date.
    '   dtmDate:
    '       date on which to start looking.
    '       Use the current date, if none was specified.
    '   adtmDates (Optional):
    '       Array containing holiday dates. Can also be a single
    '       date value, if that's what you want.
    ' Out:
    '   Return Value:
    '       The date of the working day lngDays from the start, taking
    '       into account weekends and holidays.
    ' Example:
    '   dhAddWorkDaysA(10, #2/9/2000#, Array(#2/16/2000#, #2/17/2000#))
    '   returns #2/25/2000#, which is the date 10 work days
    '   after 2/9/2000, if you treat 2/16 and 2/17 as holidays
    '   (just made-up holidays, for example purposes only).
 
    ' Did the caller pass in a date? If not, use
    ' the current date.
    Dim lngCount As Long
    Dim dtmTemp As Date
    Dim dtAnnee As Date
 
 
    If dtmDate = 0 Then
        dtmDate = Date
    End If
 
    dtAnnee = Year(dtmDate)
 
    adtmDates = Array(DateSerial(anneeDate, 1, 1), _
                DateSerial(anneeDate, 5, 1), _
                DateSerial(anneeDate, 5, 14), _
                DateSerial(anneeDate, 7, 21), _
                DateSerial(anneeDate, 8, 15), _
                DateSerial(anneeDate, 11, 1), _
                DateSerial(anneeDate, 11, 11), _
                DateSerial(anneeDate, 12, 25))
    dtmTemp = dtmDate
    For lngCount = 1 To lngDays
        dtmTemp = dhNextWorkdayA(dtmTemp, adtmDates)
    Next lngCount
    dhAddWorkDaysA = dtmTemp
End Function