Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 947 fois - Téléchargée 15 fois
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
15 mars 2015 à 16:17
Merci à toi pour ce snippet.
cdlt
15 mars 2015 à 16:09
15 mars 2015 à 11:48
15 mars 2015 à 11:38
il y a un petit problème pour l'année 2017!
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.