calcul date échéance

**popofpopof** · 19/08/2008, 18h10

bonjour

j'ai une situation ( facture) avec une date "DATE_SITUATION" et ensuite 2 champ
- "NBJOURSPAIEMENT" ou l'on saisie la durée de l'écheance 15 jours, 30 60...
- "DATE_PAIEMENT" ou l'on a une liste déroulante avec pour liste valeurs 10;"Le 10";20;"Le 20";90;"Fin de Mois". Donc si on choisi dans la liste déroulante "Le 20" dans le champ il y aura marque 20 idem pour Fin de mois mais il sera marqué 90.

je souhaite dans le champ "DATE_REGLEMENT" avoir le résultat quand on change la date "DATE_SITUATION" donc aprés mise a jour.

Je ne sais comment faire qui peux m'aide?

**LE VIEUX** · 19/08/2008, 18h50

bonsoir,
si j'ai bien compris ça devrait être çà :

Code :

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

1
2
3
Private Sub DATE_SITUATION_AfterUpdate()
Me.DATE_REGLEMENT.Value = Me.DATE_PAIEMENT.Colum(x) 'x= N° de ta colonne dans la liste déroulante
End Sub

mais j'ai pas testé !

**popofpopof** · 19/08/2008, 18h53

sa prend pas en compte le paiement le 10 du mois ou le 20 du mois et la fin du mois du comprend??

**LE VIEUX** · 19/08/2008, 19h22

non c'est bien ce que je craignais je ne vois pas bien ce que tu recherches, le code que je t'ai proposé doit normalement, si tu selectionne la bonne colonne simplement recopier dans DATE_REGLEMENT ce que tu as saisie dans ta liste déroulante DATE_PAIEMENT soit 10, 20 ou 90 ou si tu mets l'autre colonne "Le 10","le 20" "Fin de mois".
si c'est vraiement une date complète de règlement précises ce qui doit y avoir dans ta zone texte DATE_REGLEMENT.
a+

**popofpopof** · 19/08/2008, 19h32

alors pour comprendre un exemple :

DATE_SITUATION = 19/08/08
NBJOURSPAIEMENT = 30 (soit 30 jours)
DATE_PAIEMENT= 20 (paiement le 20 du mois increment jusqu'au prochain 20 (il y aura peut etre changement de mois)

résultat 22/08/08 + 30 = 22/09/08 et ensuite le 20 du mois suivant soit 20/10/08

si on prend le 05/08/08 on doit avoir 20/09/08

du comprend ??

Pour info ma liste déroulante n'est pas dans le même formulaire il faut juste prendre les donnes qui sont dans ces 3 champ.

**zEndymion** · 19/08/2008, 20h51

Hello,

Suite à ton MP, je n'ai pas le code sous la main (envacance pas au travail ...

),

J'ai donc écrit cette petite function qui doit faire la même chose :

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
 
Function Calc_DatePaiement(pDateReference As Date, pNbJourDecal As Long, pJourPaiement As Long) As Date
 
    ' pDateReference = Date de référence
    ' pNbJourDecal   = Nonbre de jour de décalage a appliquer à la date de ref (>=0)
    ' pJourPaiement  = Jour de paiment dans le mois (>0):
    '                       -> Si = à 99 Fin de mois
 
    ' Règle : si la date de paiment est > à la date de référence décalé alors il
    '         peut y avoir un changement de mois
 
 
 
    Dim vDateDecale As Date
 
 
    On Error GoTo Lbloups:
 
    ' Ctl des variables
    If pNbJourDecal < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le nombre de jour de décalage doit être >=0"
        Exit Function
    End If
 
    If pJourPaiement < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le jour de paiement doit être >0"
        Exit Function
    End If
 
    ' Tout va bien en continue
    '
 
 
    ' Calcul de la date décalé
    vDateDecale = DateAdd("d", pNbJourDecal, pDateReference)
 
    ' Controle du nombre de jour de paiement
    If pJourPaiement = 99 Then
        vDateDecale = LastDayMonth(vDateDecale)
    Else
        ' Ctl si lejour de la date décalé est > au jour de paiement
        If CLng(Day(vDateDecale)) <= pJourPaiement Then
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
        Else
            ' On décale le mois de 1 en plus
            vDateDecale = DateAdd("m", 1, vDateDecale)
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
        End If
    End If
 
 
    Calc_DatePaiement = vDateDecale
 
    Exit Function
 
Lbloups:
 
    Select Case Err.Number
        ' Ta gestion d'erreur
 
        Case Else
            Err.Raise Err.Number, "Calc_DatePaiement." & Err.Source, Err.Description
            Calc_DatePaiement = "00:00:00"
 
    End Select
 
End Function
 
 
 
Function LastDayMonth(LaDate As Date) As Date
    LastDayMonth = DateSerial(Year(LaDate), Month(LaDate) + 1, 0)
End Function

Cela reprend les règles que a donner plus tôt , mais teste quand même,
Pour le princpe la fonction accepte trois variable :
la date de référence , le nombre de jour (calendaire) de décalage , le jour de paiement attention au valeur > 28) cela peut renvoyer des date erronées) (Si 99 alors 'Fin de Mois')

Voilà
@+

**popofpopof** · 19/08/2008, 21h19

merci bcp sa marche super bien comme je voulai et je suis en train de reprendre ton code pour le comprendre merci bcp

sujet résolu

**popofpopof** · 27/01/2009, 21h18

j'ai un petit souci avec le code suivant :

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
 
    ' pDateReference = Date de référence
    ' pNbJourDecal   = Nonbre de jour de décalage a appliquer à la date de ref (>=0)
    ' pJourPaiement  = Jour de paiment dans le mois (>0):
    '                       -> Si = à 99 Fin de mois
 
    ' Règle : si la date de paiment est > à la date de référence décalé alors il
    '         peut y avoir un changement de mois
 
    Dim vDateDecale As Date
    On Error GoTo Lbloups:
 
    ' Ctl des variables
    If pNbJourDecal < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le nombre de jour de décalage doit être >=0"
        Exit Function
    End If
 
    If pJourPaiement < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le jour de paiement doit être >0"
        Exit Function
    End If
 
    ' Tout va bien en continue
    '
    ' Calcul de la date décalé
    vDateDecale = DateAdd("d", pNbJourDecal, pDateReference)
 
    ' Controle du nombre de jour de paiement
    If pJourPaiement = 90 Then
        vDateDecale = LastDayMonth(vDateDecale)
    Else
        ' Ctl si lejour de la date décalé est > au jour de paiement
        If CLng(Day(vDateDecale)) <= pJourPaiement Then
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
        Else
            ' On décale le mois de 1 en plus
            vDateDecale = DateAdd("m", 1, vDateDecale)
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
        End If
    End If
 
    Calc_DatePaiement = vDateDecale
 
    Exit Function
 
Lbloups:
 
    Select Case Err.Number
        ' Ta gestion d'erreur
        Case Else
            Err.Raise Err.Number, "Calc_DatePaiement." & Err.source, Err.Description
            Calc_DatePaiement = "00:00:00"
 
    End Select
 
End Function

Code :

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

DATE_REGLEMENT = Calc_DatePaiement(DATE_SITUATION, NBJOURSPAIEMENT, DATE_PAIEMENT)

car quand je rentre dans DATE_SITUATION une date "31/01/09" dans NBJOURSPAIEMENT= 30" ( 30 jours) et DATE_PAIEMENT= 90 ( donc fin de mois) je devrai avoir 28/02/09 mais il me donne 31/03/09 le tout a cause du 28/02 comment faire pour evité cette erreur??

**zEndymion** · 27/01/2009, 22h13

Hello,

Hum, Hum ... Sous réserve que tu n'ais pas fait une faute de frappe, je pense que l'erreur vient du fait que tu rentre "90" comme paramètre et non "99"

@+

**popofpopof** · 27/01/2009, 22h39

j'ai essai de remplace la valeur 90 par 99 mais j'ai toujour le même probleme!!

**User** · 27/01/2009, 22h51

Comme cela a été indiqué:

cela vient du fait que:

31/01/2009 + 30 = 02/03/2009

on saut le mois de fevrier

Une solution serait de faire un test avant, pour pNbJourDecal=30, du genre:

Code :

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

1
2
3
4
5
6
7
8
9
10
 
vDateDecale = DateAdd("d", pNbJourDecal, pDateReference)
 
...
 
   If DateDiff("m", pDateReference,  vDateDecale) > 1 and (pNbJourDecal=30) Then
        vDateDecale = DateAdd("m", -1,  vDateDecale) ' on enleve 1 mois
    End If
 
...

A+

**popofpopof** · 16/02/2009, 21h40

j'ai encore un probleme avec le mois de février

si ma date de situation est le 28/01/09 avec un reglement a 30 le 10
il me donne le 10/02/09 au lieu du 10/03/09

qui peux me dire au j'ai le probleme??

voila mon code complet

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
Function Calc_DatePaiement(pDateReference As Date, pNbJourDecal As Long, pJourPaiement As Long) As Date
 
    ' pDateReference = Date de référence
    ' pNbJourDecal   = Nonbre de jour de décalage a appliquer à la date de ref (>=0)
    ' pJourPaiement  = Jour de paiment dans le mois (>0):
    '                       -> Si = à 99 Fin de mois
 
    ' Règle : si la date de paiment est > à la date de référence décalé alors il
    '         peut y avoir un changement de mois
 
    Dim vDateDecale As Date
    On Error GoTo Lbloups:
 
    ' Ctl des variables
    If pNbJourDecal < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le nombre de jour de décalage doit être >=0"
        Exit Function
    End If
 
    If pJourPaiement < 0 Then
        Err.Raise 0, "Calc_DatePaiement", "Le jour de paiement doit être >0"
        Exit Function
    End If
 
    ' Tout va bien en continue
    '
    ' Calcul de la date décalé
    vDateDecale = DateAdd("d", pNbJourDecal, pDateReference)
 
    ' Controle du nombre de jour de paiement
    If pJourPaiement = 99 Then
        vDateDecale = LastDayMonth(vDateDecale)
                           If DateDiff("m", pDateReference, vDateDecale) > 1 And (pNbJourDecal = 30) Then
        vDateDecale = DateAdd("m", -1, vDateDecale)  ' on enleve 1 mois
    End If
    Else
        ' Ctl si lejour de la date décalé est > au jour de paiement
 
 
        If CLng(Day(vDateDecale)) <= pJourPaiement Then
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
        Else
            ' On décale le mois de 1 en plus
            vDateDecale = DateAdd("m", 1, vDateDecale)
            vDateDecale = DateSerial(Year(vDateDecale), Month(vDateDecale), pJourPaiement)
                       If DateDiff("m", pDateReference, vDateDecale) > 1 And (pNbJourDecal = 30) Then
        vDateDecale = DateAdd("m", -1, vDateDecale)  ' on enleve 1 mois
    End If
 
        End If
    End If
 
    Calc_DatePaiement = vDateDecale
 
    Exit Function
 
Lbloups:
 
    Select Case Err.Number
        ' Ta gestion d'erreur
        Case Else
            Err.Raise Err.Number, "Calc_DatePaiement." & Err.source, Err.Description
            Calc_DatePaiement = "00:00:00"
 
    End Select
 
End Function

**ilank** · 16/02/2009, 23h31

Bonsoir les gens,
popofpopof essaie ce code ci :

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
Function Calc_DatePaiement(pDateReference As Date, pNbJourDecal As Long, pJourPaiement As Long) As Date
 Dim DateRef As Date, i As Byte
 DateRef = pDateReference
     Select Case pJourPaiement
        Case 10, 20
            Do While CLng(DateRef + pNbJourDecal) > CLng(DateSerial(Year(pDateReference), Month(pDateReference), pJourPaiement))
                pDateReference = DateSerial(Year(pDateReference), Month(pDateReference) + 1, pJourPaiement)
            Loop
        Case 90
            If pNbJourDecal \ 30 > 0 Then
                pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), 1 + Int(pNbJourDecal / 30) + Month(pDateReference), 1))
            Else
               i = 1
                Do
                    pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), i + Month(pDateReference), 1))
                    i = 2
                Loop While CLng(DateRef + pNbJourDecal) > CLng(pDateReference)
            End If
    End Select
    Calc_DatePaiement = pDateReference
End Function

**popofpopof** · 17/02/2009, 06h27

Merci pour ton code je teste sa cette semaine

mais a premiere vu sa a l'air de bien marcher...

**popofpopof** · 12/10/2009, 21h27

bonjour j'ai encore un petit probleme :
voila le code

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
Function Calc_DatePaiement(pDateReference As Date, pNbJourDecal As Long, pJourPaiement As Long) As Date
 
    ' pDateReference = Date de référence
    ' pNbJourDecal   = Nonbre de jour de décalage a appliquer à la date de ref (>=0)
    ' pJourPaiement  = Jour de paiment dans le mois (>0):
    '                       -> Si = à 99 Fin de mois
 
    ' Règle : si la date de paiment est > à la date de référence décalé alors il
    '         peut y avoir un changement de mois
 
    Dim DateRef As Date, i As Byte
 DateRef = pDateReference
     Select Case pJourPaiement
        Case 10, 20
            Do While CLng(DateRef + pNbJourDecal) > CLng(DateSerial(Year(pDateReference), Month(pDateReference), pJourPaiement))
                pDateReference = DateSerial(Year(pDateReference), Month(pDateReference) + 1, pJourPaiement)
            Loop
        Case 99
            If pNbJourDecal \ 30 > 0 Then
                pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), 1 + Int(pNbJourDecal / 30) + Month(pDateReference), 1))
            Else
               i = 1
                Do
                    pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), i + Month(pDateReference), 1))
                    i = 2
                Loop While CLng(DateRef + pNbJourDecal) > CLng(pDateReference)
            End If
    End Select
    Calc_DatePaiement = pDateReference
 
 
End Function

Mon probléme est que quand pJourPaiement= 99 donc fin de mois j'ai comme résultat :
ex : pour 45 jours fin de mois
Date de situation : 30/09/09-> date de réglement : 15/11/09
Date de situation : 25/09/09 -> date de reglement : 15/11/09
Date de situation : 20/09/09 -> date de reglement : 15/11/09

alors que actuellement sa me donne :
Date de situation : 30/09/09-> date de réglement : 31/10/09
Date de situation : 25/09/09 -> date de reglement : 31/10/09
Date de situation : 20/09/09 -> date de reglement : 31/10/09

en gros il faut pour la date de la situation allée jusqu'a la fin du mois puis ajoute le nombre de jours. j'arrive pas a trouve vous pouvez m'aide??

**ilank** · 12/10/2009, 23h12

Bonsoir,

effectivement, le code fonctionne pour des mutilples de 30 jours, 60 et 90 jours pas pour 45...

Bref, il faut ajouter cette ligne

Code :

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

pDateReference = DateAdd("d", (pNbJourDecal Mod 30), pDateReference)

de manière à obtenir

Code :

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

1
2
3
4
5
6
7
....
        Case 90
            If pNbJourDecal \ 30 > 0 Then
                pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), 1 + Int(pNbJourDecal / 30) + Month(pDateReference), 1))
                pDateReference = DateAdd("d", (pNbJourDecal Mod 30), pDateReference)
            Else
....

**popofpopof** · 13/10/2009, 06h43

ok merci sa marche super pour 45 jour mais sa plante pour 15 jours
20/09/09 me donne 31/10/09

**ilank** · 13/10/2009, 20h13

Bonsoir,

Essaie ceci alors

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
Function Calc_DatePaiement(pDateReference As Date, pNbJourDecal As Long, pJourPaiement As Long) As Date
 Dim DateRef As Date, i As Byte
 DateRef = pDateReference
     Select Case pJourPaiement
        Case 10, 20
            pDateReference = DateSerial(Year(DateRef),Month(DateRef),pJourPaiement)
            Do While CLng(DateRef + pNbJourDecal) > CLng(pDateReference)
               pDateReference = DateAdd("m",1, pDateReference)
            Loop
        Case 90
            pDateReference = DateAdd("d", -1, DateSerial(Year(pDateReference), 1 + Int(pNbJourDecal / 30) + Month(pDateReference), 1))
            pDateReference = DateAdd("d", (pNbJourDecal Mod 30), pDateReference)
    End Select
    Calc_DatePaiement = pDateReference
End Function

**popofpopof** · 13/10/2009, 20h39

Merci bcp c'est bien sa, sa marche super bien...

calcul date échéance

IHM

Discussions similaires

Partager

Partager