Bonjour !
Vous trouverez dans ce snippet un code simple qui éffectue une boucle
semaine par semaine sur une année complète.
Une belle boucle bien pratique en moins de 10 lignes de code ^^.
J'ai collé un exemple d'utilisation dans le header de la class "DateEx".
En dessous du commentaire
TODO vous aurez l'accès à diverses
informations sur la date en cours d'énumération.
La variable
dx contient ces informations, elle pointe vers
une structure de la class, mise à jour depuis la boucle avec la procédure
UpdateDay.
Mise à jour du 15-03-15 à 12:47
La fonction "DateWeeks()" a été mise à jour.
Dans la structure "DateInfo", j'ai renommé _SemaineAjusté par _SemaineVirtuelle.
Première conclusion après avoir revu le code...
La semaine carré de 52 semaines est impossible lorsqu'on la commence un Lundi.
Virtuellement, il y a des années de 52 semaines et d'autres de 53 semaines.
Cette source reste tout de même un modèle simple puisqu'il ne rentrera pas dans
les détails précis de l'année équinoxiale.
Merci pour vos commentaires.
Mise à jour du 15-03-15 à 13:45
Voilà, une dernière mise à jour pour être conforme au titre du snippet.
Imports System.Globalization
''---------------------------------------------------
''EXEMPLE D'UTILISATION:
''---------------------------------------------------
'Dim dx As DateEx = New DateEx(New Date(InputBox("Année ?"), 1, 1))
'
''Boucle sur chaque semaine de l'année
'For idSemaine As Integer = 1 To dx.DateWeeks
' 'Ajuste la date pour commencer la boucle sur chaque Lundi
' Call dx.FirstDayOfWeek()
' 'Boucle sur 7 jours, du Lundi au Dimanche
' For idJour As Integer = 0 To 6
' 'Met à jour les informations concernant la date en cours
' Call dx.UpdateDay(idSemaine)
' 'TODO ---------------------------------------------------------------------------
' Debug.Print(vbTab & "-Semaine n°: " & dx.ThisInfo._SemaineVirtuelle & _
' " - Jour n°: " & idJour + 1 & _
' " - " & dx.ThisInfo._LongDateString)
' 'Met à jour la date en l'incrémentant d'un jour
' Call dx.NextDay()
' Next
'Next
'dx.Dispose()
'dx = Nothing
Public Class DateEx : Implements IDisposable
#Region "STRUCTURES"
Structure DateInfo
Dim _Date As Date
Dim _DateString As String
Dim _Annee As Integer
Dim _SemaineRéel As Integer
Dim _SemaineVirtuelle As Integer
Dim _Mois As Integer
Dim _Jour As Integer
Dim _LongDateString As String
Dim _JourString As String
Dim _JourMoisString As String
Dim _JourMoisShortString As String
Dim _MoisString As String
Dim _MoisShortString As String
Sub New(ByVal d As Date, ByVal SemaineEnCours As Integer)
Me._Date = d
Me._DateString = d.ToString("dd/MM/yyyy")
Me._Annee = d.Year
Me._Mois = d.Month
Me._Jour = d.Day
Me._LongDateString = d.ToLongDateString
Me._JourString = d.ToString("dddd")
Me._JourMoisString = d.ToString("m")
Me._MoisString = d.ToString("MMMM")
Me._MoisShortString = d.ToString("MMM")
Me._JourMoisShortString = d.Day & "-" & Me._MoisShortString
Me._SemaineRéel = CultureInfo.CurrentCulture.Calendar.GetWeekOfYear(d, CalendarWeekRule.FirstFullWeek, DayOfWeek.Monday)
Me._SemaineVirtuelle = SemaineEnCours
End Sub
End Structure
#End Region
#Region "PUBLIC FUNCTIONS"
Public Sub FirstDayOfWeek()
Dim NomJour As DayOfWeek = Me.ThisDate.DayOfWeek
Dim Decal As Integer
Select Case NomJour
Case DayOfWeek.Monday 'Lundi
Decal = 0
Case DayOfWeek.Tuesday 'Mardi
Decal = -1
Case DayOfWeek.Wednesday 'Mercredi
Decal = -2
Case DayOfWeek.Thursday 'Jeudi
Decal = -3
Case DayOfWeek.Friday 'Vendredi
Decal = -4
Case DayOfWeek.Saturday 'Samedi
Decal = -5
Case DayOfWeek.Sunday 'Dimanche
Decal = -6
End Select
Me.ThisDate = Me.ThisDate.AddDays(Decal)
End Sub
Public Function DateWeeks() As Integer
Dim Cal As Calendar = CultureInfo.CurrentCulture.Calendar
Dim FinAnnee As Date = New Date(Me.ThisDate.Year, 12, 31)
Dim nbWeeks As Integer = Cal.GetWeekOfYear(FinAnnee, CalendarWeekRule.FirstFullWeek, DayOfWeek.Sunday)
Return nbWeeks
End Function
Public Function DayWeek(ByVal d As Date) As Integer
Dim Cal As Calendar = CultureInfo.CurrentCulture.Calendar
Dim rt As Integer = Cal.GetDayOfWeek(d)
Return rt
End Function
Public Sub NextDay()
Me.ThisDate = Me.ThisDate.AddDays(1)
End Sub
Public Sub UpdateDay(ByVal SemaineEnCours As Integer)
Me.ThisInfo = New DateInfo(Me.ThisDate, SemaineEnCours)
End Sub
#End Region
#Region "MAIN CLASS"
Private AlreadyDisposed As Boolean
Public ThisDate As Date
Public ThisInfo As DateInfo
Sub New(ByRef StartDate As Date)
AlreadyDisposed = False
Me.ThisDate = StartDate
Me.ThisInfo = New DateInfo(Me.ThisDate, 0)
End Sub
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.AlreadyDisposed Then
If disposing Then
Me.ThisInfo = Nothing
Me.ThisDate = Nothing
End If
End If
Me.AlreadyDisposed = True
End Sub
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
GC.ReRegisterForFinalize(Me)
GC.Collect()
End Sub
#End Region
End Class
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.