Accueil > > > RETROUVER LE NUMERO DE LA SEMAINE D'UNE DATE DONNÉE
RETROUVER LE NUMERO DE LA SEMAINE D'UNE DATE DONNÉE
Information sur la source
Description
->NumeroSemaine est la function qui renvoie le numero de la semaine d'une date donnée a part ca : JJ fonction renvoie la date julienne a partir d'une date donnée JourSemaine renvoie le jour de la semaine pour une date donnée (0 = Dimanche,1 = Lundi...) JourAnnée renvoie le numero du jour donnée dans l'année (1 = 01/01)
Source
- Option Explicit
-
- Private Function JJ(Dates As Date)
- Dim y As Long, m As Long, DDdd As Double
- Dim YYYY As Long, MM As Long
- Dim a As Double, b As Double
-
- YYYY = Year(Dates)
- MM = Month(Dates)
- DDdd = Day(Dates) + Hour(Dates) / 24 + Minute(Dates) / 24 / 60 + Second(Dates) / 24 / 60 / 60
-
- If MM <= 2 Then y = YYYY - 1: m = MM + 12 Else y = YYYY: m = MM
- If Dates >= 1582.1015 Then
- a = y \ 100
- b = 2 - a + a \ 4
- End If
-
- If y = Abs(y) Then
- JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5 + b
- Else
- JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5
- End If
- End Function
-
- Private Function JourSemaine(Dat As Date) As Long
- Dim a As Double
- a = JJ(Dat) + 1.5
- a = a Mod 7
- JourSemaine = a
- End Function
-
- Private Function JourAnnée(Dat As Date) As Integer
- Dim I As Integer
- I = Year(Dat)
- If (I Mod 400 = 0) Or ((I Mod 100 <> 0) And (I Mod 4 = 0)) Then
- JourAnnée = Int((275 * Month(Dat)) / 9) - Int((Month(Dat) + 9) / 12) + Day(Dat) - 30
- Else
- JourAnnée = Int((275 * Month(Dat)) / 9) - (2 * Int((Month(Dat) + 9) / 12)) + Day(Dat) - 30
- End If
- End Function
-
- Public Function NumeroSemaine(Dates As Date) As Byte
- Dim NbJour1ereSemaine As Byte, JourJulienDates As Double, JourJulien1Janvier
- Dim JourSemaine1Janvier As Byte, JourAnneeDates As Integer
-
- JourJulienDates = JJ(Dates)
- JourJulien1Janvier = JJ(DateSerial(Year(Dates), 1, 1))
- JourSemaine1Janvier = JourSemaine(DateSerial(Year(Dates), 1, 1) + TimeSerial(0, 0, 0))
-
- If JourSemaine1Janvier = 0 Then
- NbJour1ereSemaine = 1
- Else
- NbJour1ereSemaine = -(JourSemaine1Janvier - 8)
- End If
-
- NumeroSemaine = Int((JourAnnée(Dates) - 1 - NbJour1ereSemaine) / 7) + 2
- If NumeroSemaine > 52 Then NumeroSemaine = NumeroSemaine - 52
- End Function
Option Explicit
Private Function JJ(Dates As Date)
Dim y As Long, m As Long, DDdd As Double
Dim YYYY As Long, MM As Long
Dim a As Double, b As Double
YYYY = Year(Dates)
MM = Month(Dates)
DDdd = Day(Dates) + Hour(Dates) / 24 + Minute(Dates) / 24 / 60 + Second(Dates) / 24 / 60 / 60
If MM <= 2 Then y = YYYY - 1: m = MM + 12 Else y = YYYY: m = MM
If Dates >= 1582.1015 Then
a = y \ 100
b = 2 - a + a \ 4
End If
If y = Abs(y) Then
JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5 + b
Else
JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5
End If
End Function
Private Function JourSemaine(Dat As Date) As Long
Dim a As Double
a = JJ(Dat) + 1.5
a = a Mod 7
JourSemaine = a
End Function
Private Function JourAnnée(Dat As Date) As Integer
Dim I As Integer
I = Year(Dat)
If (I Mod 400 = 0) Or ((I Mod 100 <> 0) And (I Mod 4 = 0)) Then
JourAnnée = Int((275 * Month(Dat)) / 9) - Int((Month(Dat) + 9) / 12) + Day(Dat) - 30
Else
JourAnnée = Int((275 * Month(Dat)) / 9) - (2 * Int((Month(Dat) + 9) / 12)) + Day(Dat) - 30
End If
End Function
Public Function NumeroSemaine(Dates As Date) As Byte
Dim NbJour1ereSemaine As Byte, JourJulienDates As Double, JourJulien1Janvier
Dim JourSemaine1Janvier As Byte, JourAnneeDates As Integer
JourJulienDates = JJ(Dates)
JourJulien1Janvier = JJ(DateSerial(Year(Dates), 1, 1))
JourSemaine1Janvier = JourSemaine(DateSerial(Year(Dates), 1, 1) + TimeSerial(0, 0, 0))
If JourSemaine1Janvier = 0 Then
NbJour1ereSemaine = 1
Else
NbJour1ereSemaine = -(JourSemaine1Janvier - 8)
End If
NumeroSemaine = Int((JourAnnée(Dates) - 1 - NbJour1ereSemaine) / 7) + 2
If NumeroSemaine > 52 Then NumeroSemaine = NumeroSemaine - 52
End Function
Conclusion
alors on met ca dans un module, on appelle NumeroSemaine ou on veut dans le code et pis si on sait pas faire un copier-coller ben faut arreter l'informatique ;)) lol
Sources du même auteur
Sources de la même categorie
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Transformation date calendrier en numéro semaine [ par creunch ]
Bonjour, J'ai creé un userform dans lequel j'ai un calendrier et un bouton "valider". Mon code actuel est le suivant: Private Sub CommandButton8_Cl
date et calendrier [ par guigui ]
existe-t-il une fonction qui à partir d'une date retourne le 1er jour de la semaine concernee et le dernier jour de cette semaine?sinon j'aimerais de
Calendrier [ par machto ]
Bonjour. Je veux utiliser (pour la 1° fois) ce composant pour sélectionner une date.Quelqu'un peut-il me dire où récupérer la date cliquée et (éve
Urgent Recherche calendrier avec le numéro de la semaine [ par jamaica ]
Salut, Je recherche une source de calendrier qui pourrait me calculer le N° de Semaine en tenant compte qu'ils y a des année de 53 semaines comme 2004
Retrouver une date à partir d'un numéro de semaine [ par CyberCorp ]
Est-il possible de retrouver la date du premier jour d'une semaine en entrant uniquement le numéro de la semaine (et l'année bien sur).Je n'ai trouvé
VB numéro de semaine jour et date [ par gothar12 ]
Bonjourje dispose de 2 combobox et d'un champ textLa 1ere combobox correspond au numéro de semaine de l'année (donc de 1 a 52) et la 2eme correspond a
Calendrier-date en gras [ par goofy584 ]
Salut,je voudrais prendre une valeur d'une listbox et afficher le date en gras dans le calendrier.j'essaie de fabriquer qqchose comme*****************
NO.SEMAINE [ par fzoul ]
Excel fournit une fonction, via une macro complémentaire, qui permet de "calculer" le numéro de semaine d'une date donnée, fonction qui
Probleme de date [ par vevel ]
Bonjour,J'ai encore un probleme avec les dates. Je voudrais savoir les codes pour qu'a partir d'une valeur au format "ww-yyyy" representant une semain
Planning d'effectifs [ par u473 ]
Je dois distribuer sur un calendrier journalier, un devis de40 hommesjours, utilisant un effectif journalier de 4 hommes, sur une semaine de 6 jours.L
|
Derniers Blogs
[WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc [TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES[TECHDAYS 2012] SESSION WEBMATRIX 2 : LE COUTEAU SUISSE GRATUIT POUR VOS DéVELOPPEMENTS WEB - SLIDES par gpommier
Suite à la session que j'ai présenté sur WebMatrix 2, vous pouvez trouver les slides ici, ainsi que les démos en packages nuget : démos1 et démos2 J'en profite pour remercier chaleureusement tous ceux qui sont venus très nombreux à cette sess...
Cliquez pour lire la suite de l'article par gpommier [SHAREPOINT] LES SESSIONS TECHDAYS 2012.[SHAREPOINT] LES SESSIONS TECHDAYS 2012. par Patrick Guimonet
Voici donc pour ceux qui n'ont pas pu venir, ou ceux qui n'ont pas pu toutes les suivre la liste des sessions SharePoint aux TechDays 2012, que je mettrais à jour dès que les liens des vidéo seront disponibles. Ou ici : http...
Cliquez pour lire la suite de l'article par Patrick Guimonet TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3TECHDAYS PARIS 2012 : SESSION PLEINIèRE JOUR 3 par ROMELARD Fabrice
Speaker: Bernard Ourghanlian Cette session est comme chaque jour transmise en live par BrainSonic, et j'ai donc suivi cette troisième pleinière par ce moyen sur mon iPad . Elle est dédiée comme chaque année à la mise en perspective de l'é...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System Easy-Planning (1.0.0.1)EASY-PLANNING (1.0.0.1)Basé sur les mêmes principes que MyPlanning, Easy-Planning permet de créer des plannings sous la ... Cliquez pour télécharger Easy-Planning
|