Jour x dans le mois [Résolu]

Signaler
Messages postés
48
Date d'inscription
lundi 13 octobre 2003
Statut
Membre
Dernière intervention
13 septembre 2007
-
Messages postés
48
Date d'inscription
lundi 13 octobre 2003
Statut
Membre
Dernière intervention
13 septembre 2007
-
Bonjour, j'aimerai faire une fonction qui en fonction du jour, du mois et de l'année me remène les dates de ce jour...
Je m'explique :
          par exemple pour le mois de juillet 2007 j'aimerai que la fonction me ramène les dates des lundis (réponses : les 2-9-16-23-30)

merci d'avance

Xynder [}:)] 59

21 réponses

Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Bon,...
Voilà qui me rassure (j'aime pas passer pour ce que je suis : un vieux)

Merci ami Chibat ... Dieu te le rendra.

Voilà donc :

Private Sub Command1_Click()  mois 3: annee 2002
  couic = 1
  Do While Month(DateSerial(annee, mois, couic)) = mois
    madate = DateSerial(annee, mois, couic)
    couic = couic + 1
    If WeekDay(madate) = vbMonday Then
      MsgBox madate
      couic = couic + 6
    End If
  Loop
End Sub
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
12
Salut,

Regarde cette source...défois que....

A+
Exploreur

 Linux a un noyau, Windows un pépin

 
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Bonjour,

Weekday te ramène le N° d'un jour
Tu peux donc extraire le N° du jour du 1er du mois et en déduire la date du 1er lundi suivant (par datadd)
Il te suffit ensuite de partir de cette dernière date et d'ajouter 7 jours (de 7 en 7) jusqu'à ne plus être dans le mois considéré.

Il te reste à ouvrir ton aide en ligne et à y voir la syntaxe de WekkDay et de DateAdd.
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonjour à tous

Il y a diverses possibilités pour obtenir tous les lundis d'un mois.
En voici une:

msgbox NbreJoursMois(07,2007, strListe)

Function NbreJoursMois(strMois, strAnnee, strListe)
Select Case (strMois)
      'Avril, Juin, Septembre, Novembre
       Case 4, 6, 9, 11
            NbreJoursMois = 30
      'Février
       Case 2
       'Si divisible par 400 alors bisextile            if (strAnnee Mod 4 0) And (strAnnee Mod 100 <> 0) Or (strAnnee Mod 400 0) Then
              NbreJoursMois = 29
           Else
              NbreJoursMois = 28
           End if
       'Les autres mois
       Case Else
            NbreJoursMois = 31
End Select
For i = 1 To NbreJoursMois    If Len(i) 1 Then i"0" & i    If Len(strMois) 1 Then strMois "0" & strMois

    If Left(FormatDateTime(CDate(i & "/" & strMois & "/" & strAnnee), 1),5) = "lundi" Then
       strListe = strliste &vbCrLf& FormatDateTime(CDate(i & "/" & strMois & "/" & strAnnee), 1)
   End If
Next  
NbreJoursMois = strListe
End Function

jean-marc
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Re,

Petite correction pour éviter "lundi".

If   DatePart("w", CDate(i & "/" & strMois & "/" & strAnnee)) = vbMonday Then
    strListe = strliste &vbCrLf& FormatDateTime(CDate(i & "/" & strMois & "/" & strAnnee), 1)
End If

jean-marc
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
Salut,


essaies ceci :


Function Jour_Voulu(xJ As String,xM As Integer, xA As Integer) As String
  Dim i As Integer
  Dim sDate As String
  Dim dDate As Date


  For i=1 To 31
    sDate=Format(i,"00") & "/" & Format(xM,"00") & "/" & Format(xA,"0000")
    If IsDate'sDate) Then
      dDate=CDate(sDate)
     If Format(dDate,"dddd")=xJ Then _
      Jour_Voulu=Jour_Voulu & "-" & i
   End If
  Next
  'supprimer le "-" du début 
  Jour_Voulu=Mid(Jour_Voulu,2,Len(Jour_Voulu)-1)
End Function


Exemple :
  Jour_Voulu("lundi",7,2007) renvoi "2-9-16-23-30"
 
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
je viens de tester telle_quelle , ça marche impecc !
juste une correction : If IsDate (sDate) Then

je suis fier de moi
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Salut à tous,

Vous ne pensiez tout de même pas "rigoler" sans moi, non ?

Private Sub Command1_Click()  mois 3: annee 2002
  j1 = WeekDay("01/" & mois & "/" & annee, vbMonday)
  For i = 0 To 4    voir DateAdd("d", 7 * i, IIf(j1 vbMonday, j1, DateAdd("d", 8 - j1, "01/" & mois & "/" & annee)))
    If Month(voir) = mois Then MsgBox voir
  Next
End Sub

Patapé... je sors ...
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Re,

Bonsoir Jacques,

Pour moi, le "IIf" est  interdit.
Je regarde ma doc côté WeekDay, car je l'utilise rarement.
On pourrait aussi passer par un tableau + un filtre.

Par contre, je ne sais pas si DateSerial existe en vb6.
Mois 07 : Annee 2007

For i=1 To Left(DateSerial(Annee , Mois+1, 1-1),2)
    If DatePart("w", CDate(i & "/" & Mois & "/" & Annee)) = vbMonday Then _
       strListe = strliste &vbCrLf& FormatDateTime(CDate(i & "/" & Mois & "/" & Annee), vbLongDate)
Next
MsgBox strListe

jean-marc
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Bonsoir Jean-Marc,

DateSerial existe bien en VB6 et ton code devrait fonctionner sans problème (mais tu boucles sur la totalité du mois)

Je ne saurais te donner tort quant à l'utilisation du IIF... Il est remplaçable par un If ... Then... Else

J'ai quant à moi surtout voulu (je l'ai dit) m'amuser un peu


Amitiés
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Re,

On jette maintenant le IIF (t'aimes pas, alors on jette) et on se sert de DateSerial (t'aimes et on garde donc), mais en bouclant non sur tous les jours mais sur un minimum; d'accord ?
Qu'est-ce que çà donne ?
Ceci, alors :

Private Sub Command1_Click()  mois 3: annee 2002
  madate = DateSerial(annee, mois, 1)
  couic = 0
  While Month(madate) = mois
    madate = DateAdd("d", couic, DateSerial(annee, mois, 1))    If WeekDay(madate) vbMonday And Month(madate) mois Then
      MsgBox madate
      couic = couic + 7
    Else
      couic = couic + 1
    End If
  Wend
End Sub
Messages postés
48
Date d'inscription
lundi 13 octobre 2003
Statut
Membre
Dernière intervention
13 septembre 2007

OK
merki à tous je vais essayé tout ça  et je verrai bien...

Xynder [}:)] 59
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Attends un peu, Xybder59,...

J'ai fait (un peu volontairement et un peu à cause du pastis,... une ... non pas une erreur, mais oui, un code inutilement redondant...). J'attendais d'être remis à ma place...
Je vois que personne n'a osé le faire et pose la question suivante à tous :
Pourquoi ? Parce que je suis un vieux ? ou quoi ?
Corrigez-moi vite (non pas, une fois de plus, cette erreur, mais cette redondance inutile).
S'il vous plait !!!
J'attends cette correction.... que chacun y aille de bon coeur et vous me ferez non pas de la peine, mais le plus grand des cadeaux ...
A bientôt.
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
 While Month(madate) = mois
    madate = DateAdd("d", couic, DateSerial(annee, mois, 1))    If WeekDay(madate) vbMonday <strike>And Month(madate) mois</strike> Then
      MsgBox madate
      couic = couic + 7
    Else
      couic = couic + 1
    End If
  Wend

c' est que j' étais faché que personne ne m' a félicité
en plus j' étais occupé avec ma nouvelle signature

<hr />Pour faire le portrait d' un poisson:
Peindre d' abord un fond.Versez-y ensuite beaucoup d' eau.
* Rolling  
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
mais il faudra dplacer madate = DateAdd("d", couic, DateSerial(annee, mois, 1))
vers la fin avant le Looping

<hr />Pour faire le portrait d' un poisson:
Peindre d' abord un fond.Versez-y ensuite beaucoup d' eau.
* Rolling  
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Ne me refaites JAMAIS plus ce coup là ! Je tiens à être engueulé moi aussi !
Please !
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
t' as pas encore fini avec moi !

Do While Month(DateSerial(annee, mois, couic)) = mois
    madate = DateSerial(annee, mois, couic)

deux fois DateSerial ...

Peux mieux faire
<hr />Pour faire le portrait d' un poisson:
Peindre d' abord un fond.Versez-y ensuite beaucoup beaucoup d' eau.

* Rolling   
Messages postés
4822
Date d'inscription
lundi 11 novembre 2002
Statut
Membre
Dernière intervention
15 novembre 2016
12
  

A+
Exploreur

 Linux a un noyau, Windows un pépin

 
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Statut
Membre
Dernière intervention
22 août 2014
25
Por fin !
Un millon de gracias à todos (y a ti sobre todo amigo camel).

Vous me faites une promesse ? Ne m'épargnez plus rien (il me semble avoir commencé à mériter d'être un peu parmi vous, non ?).
Messages postés
1883
Date d'inscription
samedi 1 avril 2006
Statut
Membre
Dernière intervention
20 novembre 2007
2
t' inquiètes pas pour les "upercutes", Marqués

les amis sont fait pour ça !

<hr />Pour faire le portrait d' un poisson:
Peindre d' abord un fond.Versez-y ensuite beaucoup d' eau.
* Rolling