macro pour afficher les dates des troisièmes vendredi du mois

**julius999** · 27/10/2009, 11h26

Bonjour à tous.

Tout d'abord excusez-moi si je poste au mauvais endroit ou si le sujet a déjà été traité (je n'ai pas été en mesure de le trouver, c'est la première fois que j'utilise un forum...

Je dois réaliser une macro devant pour une année donnée afficher les dates des troisièmes vendredi du mois.

A part insérer un inputbox, je ne vois pas trop comment coder tout ça, ce qui bien évidement ne m'aide pas dans l'avancée de mon projet.

Si d'aventure quelqu'un pouvait m'aider, j'apprécierais vraiment
Par avance merci et bonne journée

**Krovax** · 27/10/2009, 11h43

Bonjour,
A défaut de faire ta macro je te propose une idée d'algorithme simple, et un lien vers une faq sur les dates

Tu boucles sur les 21 premier jour du moi et pour chaque jour tu testes le jour de la semaine
Si c'est un vendredi tu incrémente un compteur de 1 quand le compteur vau 3 tu concerve la date tu remet le compteur a 0 et tu passe au mois suivant

Le lien vers la faq
http://access.developpez.com/faq/?pa...#NumJourSmaine

les fonction utile

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Weekday()
 DateSerial(anneeDate, NumeroDuMoi, NumeroDuJour)

**julius999** · 27/10/2009, 12h10

merci beaucoup, je vais essayer avec ça et je devrai me débrouiller

Ah ouai aussi, comment je fais pour qu'en donnant l'année, excel affiche toutes les jours de l'année, en tenant compte des années bissextiles

**Fvandermeulen** · 27/10/2009, 13h32

Salut Julius999 (et Krovax)

qu'entend tu par

Ah ouai aussi, comment je fais pour qu'en donnant l'année, excel affiche toutes les jours de l'année, en tenant compte des années bissextiles

Tu veux dire les dates listées sur une feuille? Il semble que ton projet soit déjà avancé ou qu'il y ait un but bien défini, au plus tu nous en dit au mieux on peut t'aider.
Car pour la réponse simple, premier jour de l'année en A1, la formule en A2 à tirer jusqu'à la cellule A366:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=IF(YEAR(A365+1)<>YEAR(A365);"";A365+1)

(Par exemple)

A+

**Krovax** · 27/10/2009, 13h33

On est d'accord là c'est une autre question qui n'a pas grand chose a voir non? (habituellement on préfère 1post=1question

)

Un lien pour insérer un calendrier dans un userform ca pourra peut être t'aider
http://silkyroad.developpez.com/VBA/...erForm/#LIII-I

**mercatog** · 27/10/2009, 14h19

Bonjour, je propose une fonction qui donne le dernier vendredi du mois

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function Vendr(ByVal annee As Integer, ByVal i As Byte)
Dim datef As Date
If i > 12 Then Exit Function
If i < 12 Then
    datef = DateAdd("d", -1, CDate("1/" & i + 1 & "/" & annee))
Else
    datef = CDate("31/12/" & annee)
End If
Vendr = DateAdd("d", datef, 1 - Weekday(datef, vbFriday))
End Function

ce code permet d'ecrire dans la colonne B les dates des derniers vendredi de chaque mois (l'année en A1)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub CommandButton1_Click()
Dim i As Byte
For i = 1 To 12
    Cells(i, 2).Value = Vendr(Cells(1, 1).Value, i)
Next i
End Sub

Edit: Oups, j'avais proposé la date du dernier vendredi,
l'avant dernier vendredi du moi (avec le même principe)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function Vendr(ByVal annee As Integer, ByVal i As Byte)
Dim datef As Date
If i > 12 Then Exit Function
If i < 12 Then
    datef = DateAdd("d", -1, CDate("1/" & i + 1 & "/" & annee))
Else
    datef = CDate("31/12/" & annee)
End If
Vendr = DateAdd("d", datef, -6 - Weekday(datef, vbFriday))
End Function

Edit2: je viens de m'appercevoir que ma proposition est loin de répondre à la question initiale, en effet:
l'avant dernier vendredi n'est pas toujours le 3ème!

**ucfoutu** · 27/10/2009, 14h47

Bonjour,

D'accord (on ne le peut plus) avec le fait de s'en tenir à la question posée initialement, à savoir dresser la liste des 3èmes vendredi de chaque mois d'une année.
Cette liste me paraiît relever beaucoup plus de l'application de l'arithmétique que d'autre chose.
Je ne vois par ailleurs ni la nécessité de s'égarer dans une boucle de test (toujours possible, mais lourd), ni celle de passer par d'autres "déterminations".

Je propose ceci, écrit à main levée et à tester, dans le bouton de commande command1 d'un UserForm (ce n'est qu'un exemple), avec une listbox nommée ListBox1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Command1_Click()
   Dim année As Integer, ladate As Date, lejour As Integer, i As Integer, lev3 As Date
  annee = 2011
  For i = 1 To 12
    ladate = dateSerial(annee, i, 1)
    lejour = datePart("w", ladate)
    lev3 = ladate + IIf(lejour <= 5, 6 - lejour, (13 - lejour) Mod 7) + 14
    listbox1.addItem Format(lev3, "dddd dd mm yyyy")
   Next
End Sub

Qu'ensuite vous utilisiez directement une macro sans userform et sans listbox et sans bouton de commande pour afficher sur une feuille ou ailleurs, le mécanisme de calcul reste le même ..
(je n'ai pas testé... je vous laisse le faire)

**julius999** · 27/10/2009, 16h37

Merci, c'est vraiment sympa toutes ces réponses, en fait si je voulais afficher toutes les dates, c'est surtout pour repérer les vendredi par une formule.
mais manifestement ça n'est pas utile. Je ne suis de loin pas un expert en VBA moi hein...

**ucfoutu** · 27/10/2009, 16h56

As-tu testé mon coide ? Te donne-t-il les résultats attendus ?
Si oui (ta réponse est importante), je le transforme pour qu'il fonctionne "universellement" (jour et rang d'occurrence du jour paramétrables).

**julius999** · 27/10/2009, 17h12

Re salut,

volà donc la macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Function Vendr(ByVal annee As Integer, ByVal i As Byte)
Dim datef As Date
If i > 12 Then Exit Function
If i < 12 Then
    datef = DateAdd("d", -1, CDate("1/" & i + 1 & "/" & annee))
Else
    datef = CDate("31/12/" & annee)
End If
Vendr = DateAdd("d", datef, -6 - Weekday(datef, vbFriday))
End Function
 
Sub vendredi()
Dim i As Byte
Range("a1") = InputBox("entrez l'année voulue")
For i = 1 To 12
    Cells(i, 2).Value = Vendr(Cells(1, 1).Value, i)
Next i
End Sub

ça joue bien, je comprends relativement bien le code sauf qu'en voulant tester pour l'année 2009, au mois d'octobre, excel m'indique 23.10 en lieu et place du 16. (2-9-16).

les mois corrects sont fév-mar-avr-jun-aug-sep-nov-dec
les faux sont: jan-mar-jul-oct

je vois pas trop là

**ucfoutu** · 27/10/2009, 17h14

ouais...
et mon code ?

**julius999** · 27/10/2009, 17h16

en fait je comprends pas trop:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

listbox1.addItem Format(lev3, "dddd dd mm yyyy")

c'est quoi un(e) listbox?

**mercatog** · 27/10/2009, 17h23

Edit2: je viens de m'appercevoir que ma proposition est loin de répondre à la question initiale, en effet:
l'avant dernier vendredi n'est pas toujours le 3ème!

après avoir testé le code d'ucfoutu

**ucfoutu** · 27/10/2009, 17h24

Alors là ...

Bon, je n'ai pas présentement Excel sous la main pour essayer, mais :
remplace :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

listbox1.addItem Format(lev3, "dddd dd mm yyyy")

par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Cells(i, 1).Value = Format(lev3, "dddd dd mm yyyy")

Fais ton test sur une feuille vierge.
Ca devrait aller ...

**ucfoutu** · 27/10/2009, 18h13

Bon et quoi qu'il en soit,
Voilà le "truc" rendu totalement flexible (année, jour choisi et rang du jour dans le mois paramétrables).
Je l'ai rédigé et testé sans Excel (je ne l'ai pas présentement sous la main mais n'en ai nul besoin pour le faire ainsi) et me suis arrangé pour que tu n'aies pas besoin de ListBox (j'envoie tout dans une message box) pour y voir clair.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim annee As Integer, ladate As Date, rang As Integer, jour As Integer, lejour As Integer, i As Integer, lejn As Date, mess As String
  annee = 2014 ' ici ton année
  rang = 2 ' ici le rang d'occurence du jour dans le mois (forcément compris entre 1 et 5) ex ici : 2ème mardi
  jour = 4 'ici le n° du jour considéré (ex 2 = mardi)
  For i = 1 To 12
    ladate = DateSerial(annee, i, 1)
    lejour = DatePart("w", ladate)
    lejn = ladate + IIf(lejour <= jour, jour + 1 - lejour, (jour + 8 - lejour) Mod 7) + (rang - 1) * 7
    'et maintenant, on va  éviter d'afficher si le mois en cause ne contient pas de jour avec ce rang, bien sûr
    ' cve qui, par exemple, pourrait arriver avec rang = 5 (un jour de la semaine pouvant apparaître 5 fois dans
    'un mois, mais pas toujours...
    If Month(lejn) = i Then
      mess = mess & Format(lejn, "dddd dd mm yyyy")
    End If
    If i < 12 Then mess = mess & vbCrLf
   Next
   MsgBox mess

Testé et fonctionne sans faille.

**mercatog** · 27/10/2009, 23h03

ci joint une autre proposition à la question initiale(j'ai bien excel et je fais mes tests sans prétendre plus)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function Vendr(ByVal annee As Integer, ByVal mois As Byte)
Dim datef As Date
If mois > 12 Then Exit Function
datef = DateSerial(annee, mois, 1)
If Weekday(datef, vbFriday) = 1 Then
    Vendr = DateSerial(annee, mois, 15)
Else
    Vendr = DateAdd("d", datef, 22 - Weekday(datef, vbFriday))
End If
End Function

**julius999** · 28/10/2009, 10h06

Salut,

Merci à tous pour vos réponses, c'est vraiment sympa. Le code de ucfoutu fonctionne parfaitement.

merci encore pour votre aide et à bientôt pour un autre problème...

cheers

Bien sûr merci également à Mercatog, ça marche bien aussi.

**ucfoutu** · 28/10/2009, 13h55

Envoyé par julius999

Bien sûr merci également à Mercatog, ça marche bien aussi.

J'irais plus loin, en ce qui me concerne :
Le code de Mercatog (un salut à Mercatog) est astucieux et montre comment utiliser intelligemment ce qu'offre VB.

**CodeFacile** · 28/10/2009, 16h57

Aller, j' ajoute ma contribution

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Public Sub troisiéme_vendredi_du_mois()
 
valeur_anne = InputBox("Entrez l'année voulue")
 
If IsNumeric(valeur_anne) = True Then
    liste = "3 ème Vendredi du Mois " & Chr(10)
    For Mois = 1 To 12
        jour = 0: nb_vend = 0
        Do
         jour = jour + 1
            If Weekday(CStr(jour) & "/" & CStr(Mois) & "/" & CStr(valeur_anne)) = vbFriday Then nb_vend = nb_vend + 1
        Loop While nb_vend < 3
        liste = liste & Chr(10) & "Vendredi " & CStr(jour) & "/" & CStr(Mois) & "/" & CStr(valeur_anne)
    Next Mois
Else
   liste = "Format Année incorrect"
End If
MsgBox liste
End Sub

**ucfoutu** · 28/10/2009, 17h12

Envoyé par ucfoutu

Bonjour,
......
Je ne vois par ailleurs ni la nécessité de s'égarer dans une boucle de test (toujours possible, mais lourd)
.....

Bonjour, codefacile,

Certes, mais c'est exactement ce qu'il est préconisé d'éviter (ta boucle de tests par Do...loop)

PS : et tant qu'à passer par une boucle de tests, tu aurais pu penser à la raccourcir (dès lors que tu avais trouvé le 1er vendredi ==>> tu avais le 3ème aisément sans passer tous les jours en revue, non ? ...)

macro pour afficher les dates des troisièmes vendredi du mois [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager