Trouve les date de début et fin de semaine pour un semaine et une année données
Soyez le premier à donner votre avis sur cette source.
Snippet vu 9 167 fois - Téléchargée 37 fois
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.
Un peu long peut-être ... mais rapide .
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
- Trouve les date de début et fin de semaine pour un semaine et une année données
- Trouve la date du lundi pour une semaine et une année données - Codes sources - Visual Basic / VB.NET (Date & Heure)
- Probleme Script calendrié avec date de debut et date de fin. ✓ - Forum - PHP
- Retrouver les dates debut et fin d'une semaine en fonction de son n° ✓ - Forum - SQL
- Après avoir entré le numéro du mois recherché, trouver la date de fin du mois (2 ✓ - Forum - Visual Basic 6
- Trouver une date a partir de son numero et vice versa - Codes sources - C / C++ / C++.NET (Divers)
Du même auteur (cs_Zeroc00l)
-
Hotplug manager : gestionnaire de plugins interchangeables en live (ou "à chaud")
-
Generation de l'expression reguliere (regexp) pour manger jusqu'a une chaine
-
Gestion (ou simulation) des évenements en c++ pure
-
Comment optimiser les timage (gain de temps et de calcul important)
-
Priorisateur d'affichage (permet d'afficher en premier plan des fenêtres windows)
(notement pour se rendre compte qu'il n'y a pas d'operateur ternaire x-D)
Enfin ! Voila la traduction brute de fonderie !
(donc à retester):
procedure AfficherDate(S : byte; Anne : Integer; L : TLabel; D : TLabel);
var A : Integer;
PeriodeJour : array[1..28] of Byte;
j : Byte;
t : Byte;
Lundi : Integer;
JourParMois : array[1..12] of Integer;
Mois : Byte;
begin
A :(Anne - 12) Mod 28; // (12 2000 mod 28 )
if (A = 0) Then A := 28;
j := 6;
for t := 1 To A do
begin
j :(j + 1 - Integer(((t - 1) Mod 4 0) And (t > 1))) Mod 7;
PeriodeJour[t] := j;
end;
Lundi := S * 7 - PeriodeJour[A] - 6;
If (Lundi < 0) Then begin
L.Caption := IntToStr(31) + IntToStr(Lundi) + '/' + IntToStr(12) + '/' + IntToStr(Anne - 1);
D.Caption := IntToStr(7 - PeriodeJour[A]) + '/' + IntToStr(11) + '/' + IntToStr(Anne);
end Else begin
JourParMois[1] := 31;
JourParMois[2] := 28;
if ((A Mod 4) = 0) then
Dec(JourParMois[2]);
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;
j := 1;
Mois := 1;
While (Lundi > JourParMois[j]) do
begin
Lundi := Lundi - JourParMois[j];
j := j + 1;
Mois := Mois + 1;
end;
L.Caption := IntToStr(Lundi) + '/' + IntToStr(Mois) + '/' + IntToStr(Anne);
Lundi := Lundi + 6;
If (Lundi > JourParMois[j]) Then begin
D.Caption := IntToStr(Lundi - JourParMois[j]) + '/';
if (Mois = 12) then
D.Caption := D.Caption + '1'
else
D.Caption := D.Caption + IntToStr(Mois + 1);
if (Mois = 12) then
Dec(Anne);
D.Caption := D.Caption + '/' + IntToStr(Anne);
end Else
D.Caption := IntToStr(Lundi) + '/' + IntToStr(Mois) + '/' + IntToStr(Anne);
end;
end;
Effectivement c'est une petite coquille ... Désolé pour ceux qui auraient utilisé ce code ...
Vala c'est corrigé ! Merci !
While Lundi > JourParMois(j)
j = j + 1
Lundi = Lundi - JourParMois(j)
Mois = Mois + 1
Wend
Il faudrait plutot mettre:
While Lundi > JourParMois(j)
Lundi = Lundi - JourParMois(j)
j = j + 1
Mois = Mois + 1
Wend
A plus
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.