1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. VB.NET - Un carré de 52 semaines

VB.NET - Un carré de 52 semaines

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 978 fois - Téléchargée 13 fois

Commenter

Contenu du snippet

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

Compatibilité : 10.0

A voir également

Ajouter un commentaire

Commentaires

Signaler
Messages postés
6868
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
7 août 2020
 109
Bonjour,

il y a un petit problème pour l'année 2017!
Signaler
Messages postés
6868
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
7 août 2020
 109 >
Messages postés
6868
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
7 août 2020
2006 et 2012 aussi. C'est curieux car il n'y a que la 1ère semaine d'afficher pour ces années.
Signaler
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
 3 >
Messages postés
6868
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
7 août 2020
Merci pour ton aide "Le Pivert". J'ai corrigé le bug ^^
Signaler
Messages postés
6868
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
7 août 2020
 109 >
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
C'est parfait.
Merci à toi pour ce snippet.
cdlt
S'inscrire maintenant

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.

Du même auteur (Duke49)