Trouve les date de début et fin de semaine pour un semaine et une année données

Commenter

Contenu du snippet

Bon étant donne le nombre croissant de personnes qui veulent les dates en fonction d'une semaine et de l'anné, j'ai décidé de chercher un peu et de faire une fonction.

Source / Exemple : 


Private Sub Command1_Click()
 Call AfficherDate(30, 2003, LL, DD) 'appelle de la fonction pour la smaine 30 de l'anne 2003
End Sub

' ********** /!\ Attention /!\ **********
'1) Cette fonction est valable pour les années comprises entre 2001 et 2399 !
'2) La semaine 0 existe ! elle peut etre entiere(1er janvier =lundi) , ou bien fractionnée (1 janvier <> Lundi ).
'     Exemple : la semaine 0 de l'anne 2005 retourne : 27/12/2004 et 2/01/2005 .
Sub AfficherDate(S As Byte, Anne As Integer, L As Label, D As Label)
 
 Dim A As Integer
 A = (Anne - 12) Mod 28 ' (12 = 2000 mod 28 )
 If A = 0 Then A = 28

 Dim PeriodeJour(28) As Byte, j As Byte, t As Byte
 j = 6

 For t = 1 To A
     j = (j + 1 - ((t - 1) Mod 4 = 0 And t > 1)) Mod 7
     PeriodeJour(t) = j
 Next t
 
 Dim Lundi As Integer
 Lundi = S * 7 - PeriodeJour(A) - 6
 If Lundi < 0 Then
    L.Caption = 31 + Lundi & "/" & 12 & "/" & Anne - 1
    D.Caption = 7 - PeriodeJour(A) & "/" & 11 & "/" & Anne
 Else
    Dim JourParMois(12)
      JourParMois(1) = 31
      JourParMois(2) = 28 - ((A Mod 4) = 0)
      JourParMois(3) = 31
      JourParMois(4) = 30
      JourParMois(5) = 31
      JourParMois(6) = 30
      JourParMois(7) = 31
      JourParMois(8) = 31
      JourParMois(9) = 30
      JourParMois(10) = 31
      JourParMois(11) = 30
      JourParMois(12) = 31
 
    Dim Mois As Byte
    j = 1
    Mois = 1
    While Lundi > JourParMois(j)
       Lundi = Lundi - JourParMois(j)
       j = j + 1
       Mois = Mois + 1
    Wend
    L.Caption = Lundi & "/" & Mois & "/" & Anne
    
    Lundi = Lundi + 6
    If Lundi > JourParMois(j) Then
       D.Caption = Lundi - JourParMois(j) & "/" & IIf(Mois = 12, 1, Mois + 1) & "/" & Anne - (Mois = 12)
    Else
       D.Caption = Lundi & "/" & Mois & "/" & Anne
    End If
 End If
End Sub

Conclusion :


Un peu long peut-être ... mais rapide .

A voir également

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 (cs_Zeroc00l)