Génerer Tranche de temps entre deux dates avec informations complémentaires.

Signaler
Messages postés
2
Date d'inscription
dimanche 25 juillet 2004
Statut
Membre
Dernière intervention
18 février 2006
-
Messages postés
59
Date d'inscription
mercredi 8 octobre 2003
Statut
Membre
Dernière intervention
22 juillet 2008
-
Bonjour à tous !

Je suis confronté à un sérieux problème étant donné mes petites connaissances en VB. Je m'explique. Je souhaite réalisé une application VB de la facon suivante.
L'utilisateur rentre une date de début et une date de fin. Dans mon exemple, date début 01/01/2005 et date de fin 31/12/2005. Ce que je souhaite c'est qu'à partir de ces dates des tranches de temps se genérent avec toujours le 28 pour solder chaque mois.

01/01/2005 --> 28/01/2005
28/01/2005 --> 28/02/2005
......
28/12/2005 --> 31/12/2005

J'ai essayé de partir avec un do while loop mais non concluant.

En gros, on part de la date de début de prestation et tant que l'on ne dépasse pas la date de fin de prestation on crée des tranches de temps jusqu'au 28.

La 2ème subtilité consiste à indiquer en fonction du mois si c'est une période hiver ( Novembre, Décembre, Janvier, Février, Mars) ou une période été ( les autres mois ). Merci d'avance pour les conseils !!

7 réponses

Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
salut,





sur une Form place 2 txtbox (Txt_Debut et Txt_Fin) et un bouton (Cmd_Calc)





çà me semble à peu près correct ^^






Option Explicit

'

'

Private Sub Form_Load()

Txt_Debut.Text = "01/01/2005"

Txt_Fin.Text = "31/12/2005"

End Sub

'

'

Private Sub Cmd_Calc_Click()

' conversion chaine / date

Dim dDebut As Date, dPeriode As Date, dFin As Date

dDebut = CDate(Txt_Debut.Text)

dPeriode = CDate(Format$(dDebut, "28/MM/YYYY"))

dFin = CDate(Txt_Fin.Text)



' verif

On Error Resume Next

If (dDebut >= dFin) Or (Err.Number <> 0) Then

MsgBox "Equart de date ou format invalide", vbCritical

Exit Sub

End If

On Error GoTo 0



Dim sMess As String: sMess = ""



' boucle

Dim lDiff As Long: lDiff = 1

While lDiff > 0



' concatène date
sMess = sMess & "du " & Format$(dDebut, "DD/MM/YYYY") & " au " & Format$(dPeriode, "DD/MM/YYYY")



' concatène saison. remplacer "dDebut" par "dPeriode" au besoin ... tu as mal expliqué ;)

If ( Month (dDebut) < 4) Or (Month(dDebut) > 10) Then

sMess = sMess & " (hiver) " & vbCrLf

Else

sMess = sMess & " ( été ) " & vbCrLf

End If



' ajoute moi suivant en gardant 28 en ref

If Day (dDebut) <> 28 Then

dDebut = CDate(Format(dDebut, "28/MM/YYYY"))

Else

dDebut = DateAdd ("m", 1, dDebut)

End If

lDiff = DateDiff("d", dDebut, dFin)



' date fin avec verif

dPeriode = DateAdd ("m", 1, dDebut)

If dPeriode > dFin Then dPeriode = dFin

Wend



' retour

MsgBox sMess

End Sub






<small> Coloration
syntaxique automatique [AFCK]</small>




PCPT [AFCK]
Messages postés
2
Date d'inscription
dimanche 25 juillet 2004
Statut
Membre
Dernière intervention
18 février 2006

Tout d'abord, merci beaucoup PCPT pour ce code illustré de commentaires. J'ai notamment pigé des petits trucs supplémentaires grâce à toi.

Aussi, connaitrais tu un tutorial pour le post traitement de la boucle dans mon exemple ?

A savoir, la création d'un tableau exploitable (je pense à du flexgrid ou datagrid) qui résumerait ligne par ligne le résultat de ma boucle ?

Cordialement,
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
salut,

non je n'en connais pas et je doute même qu'il y en ait juste pour une
application de boucle dans un objet.... (quoi que, faut fouiller ^^)



admettons une Flex, il te suffit d'ajouter un compteur dans la boucle (disons iCpt).

1 2 3 correspondra alors à la ligne.

et la colonne, tu l'as déjà :



donc dans l'idée et de mémoire (non vérifié)...

Flex.TextMatrix(iCpt,1) = Format$(dDebut, "DD/MM/YYYY")

Flex.TextMatrix(iCpt,2) = Format$(dPeriode, "DD/MM/YYYY")

If ( Month (dDebut) < 4) Or (Month(dDebut) > 10) Then
Flex.TextMatrix(iCpt,3) ="hiver"

Else
Flex.TextMatrix(iCpt,3) ="été"
End If





++
Messages postés
59
Date d'inscription
mercredi 8 octobre 2003
Statut
Membre
Dernière intervention
22 juillet 2008

J'ai réussit à faire un petit code et j'espère que ça correspond à tes attentes (c'est simple en plus :) )

Dim datedeb As Date
Dim datefin As Date
Dim date_28 As Date
Dim msg As String

datedeb = "01/01/2006" ' date de départ
datefin = "31/12/2006" ' date de fin
msg = ""

'DateAdd(type d'intervalle, nombre à ajouter, date)

While (datedeb < datefin)
date_28 = DateAdd("d", 28 - 1, datedeb) 'on ajoute 28 jours msg msg & datedeb & "> " & date_28 & vbCrLf 'on affiche l'intervalle trouvé
datedeb = DateAdd("d", 1, date_28) ' on calcule la nouvelle date de départ
Wend
MsgBox msg
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
47
salut Schtroumf ....

tu l'as essayé ton code?



je remplace MsgBox par Debug.Print :



01/01/2006 => 28/01/2006

29/01/2006 => 25/02/2006

26/02/2006 => 25/03/2006

26/03/2006 => 22/04/2006

23/04/2006 => 20/05/2006

21/05/2006 => 17/06/2006

18/06/2006 => 15/07/2006

16/07/2006 => 12/08/2006

13/08/2006 => 09/09/2006

10/09/2006 => 07/10/2006

08/10/2006 => 04/11/2006

05/11/2006 => 02/12/2006

03/12/2006 => 30/12/2006



pas top :-$

++
Messages postés
59
Date d'inscription
mercredi 8 octobre 2003
Statut
Membre
Dernière intervention
22 juillet 2008

Oups pardon, j'ai mal compris ton problème... je croyais que tu voulais avoir de tranches de 28 jours. Excuse moi
Messages postés
59
Date d'inscription
mercredi 8 octobre 2003
Statut
Membre
Dernière intervention
22 juillet 2008

Bon, là je crois que j'ai bien compris le problème (dum moins j'espère) vu que ça donne les mêmes résultats que le code de pcpt

J'ai tout de même ajouter quelques trucs comme la gestion d'une date de début dont le jour est le 28, 29, 30 ou 31 et la gestion d'un intervalle inférieur à 1 mois (exemple 29/01/2005 au 10/02/2006)

Dim datedeb As Date
Dim datefin As Date
Dim date_28 As Date
Dim msg As String


datedeb = "01/01/2006" ' date de départ
datefin = "31/12/2006" ' date de fin
msg = ""


If (datedeb > datefin) Then
MsgBox "période invalide"
End
End If


If ((Format(datedeb, "d") < 28) Or (DateAdd("m", 1, datedeb) < datefin)) Then


If (Format(datedeb, "d") < 28) Then 'le jour de la date de début est < à 28
date2 = "28/" & Format(datedeb, "mm") & "/" & Format(datedeb, "yyyy")
Else 'le jour de la date de début est > ou= à 28
date2 = DateAdd("m", 1, datedeb)
date2 = "28/" & Format(date2, "mm") & "/" & Format(date2, "yyyy")
End If msg msg & datedeb & "> " & date2 & vbCrLf


While (date2 < datefin)
date_28 = DateAdd("m", 1, date2) 'on ajoute 1 mois
If (date_28 < datefin) Then 'on n'est pas à la fin msg msg & date2 & "> " & date_28 & vbCrLf 'on stocke l'intervalle trouvé
Else 'on a traité tout l'intervalle msg msg & date2 & "> " & datefin & vbCrLf 'on stocke l'intervalle trouvé
End If
date2 = date_28
Wend


Else msg datedeb & "> " & datefin

End If
Debug.Print msg