Agenda sportif annuel

Bonjour à tous, j'ai élaboré un agenda pour la région Normandie, discipline Sport boules. Il est entièrement opérationnel avec listes déroulantes, MFC et calendrier de Mike Steelson. Les dates sont dans la colonne B, le calendrier s'affiche sur chaque cellule. J'aurais voulu savoir si il était possible après avoir mis la date dans la première cellule, d'avoir un remplissage automatique de la colonne B, sachant que l'on utilise que le jeudi, samedi, dimanche et jours fériés. Si un de vous vous à la gentillesse et le courage de se pencher sur ce sujet, merci. Sinon pas grave.

Bonne soirée

Bonsoir,

une tentative presque concluante : en cellule B4 :
=SI(OU(JOURSEM(B3+1;2)=4;JOURSEM(B3+1;2)>5;B3+1=Fériés);B3+1;SERIE.JOUR.OUVRE.INTL(B3;1;"1110100"))

cela fonctionne pour les jeudi samedi et dimanche, et pour les jours fériés qui sont le "lendemain" de l'un de ces jours.
Donc pour le lundi 11 novembre cela fonctionne car la veille est un dimanche.
Pour le mercredi 01 janvier cela ne marche pas car la veille est un mardi...

Mais je ne suis partie que sur une formule, avec du VBA ce sera plus simple...

@ bientôt

LouReeD

En VBA, laborieux, il y a peut-être plus simple mais ce ci fonctionne :

Sub ChoixDate(quand)
On Error Resume Next ' cas où le calendrier est resté actif à la fermeture
Dim Sh As Object, Incrémente, Ligne
    MSjour.Value = quand
    Incrémente = 1
    Ligne = 4
    Do
        If Weekday(Cells(Ligne - 1, 2) + Incrémente, vbMonday) = 4 Or Weekday(Cells(Ligne - 1, 2) + Incrémente, vbMonday) > 5 Or EstJourFerie(CDate(Cells(Ligne - 1, 2) + Incrémente)) Then
            Cells(Ligne, 2).Value = Cells(Ligne - 1, 2) + Incrémente
            Ligne = Ligne + 1
            Incrémente = 1
        Else
            Incrémente = Incrémente + 1
        End If
    Loop While Ligne < 41
    Set MSjour = Nothing
    For Each Sh In ActiveSheet.Shapes
        If Left(Sh.Name, Len(prefixe)) = prefixe Then Sh.Delete
    Next
End Sub

Il vous faut remplacer le code d'origine par ce dernier.

@ bientôt

LouReeD

Bonjour LouReeD, avec la formule, j'ai une erreur nom en B4, avec le code, j'ai supprimé les 2 codes du calendrier existant, feuille et module, j'ai mis votre dans l'un ou l'autre sans résultat. Je ne suis pas très doué avec excel, mais là je suis coincé, merci d'avoir bossé pour sur ce sujet.

Bonne journée

Didier

Bonjour,

Pardon, seule la procédure ChoixDate est à remplacer dans le code.

Pour le #nom! C'est normal et la encore pardon.

Pour que la formule fonctionne (presque) il faut une plage de cellule nommée Fériés qui contient les dates des jours fériés, mais comme elle ne fonctionne pas à 100% prenez l'option VBA.

@ bientôt

LouReeD

Bonjour le forum,
Salut Didier, LouReed ,

Premier jet

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'
Dim dDate As Date, dNDate As Date, dEaster As Date, iRow%, iIdx%, iEaster%
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("B3")) Is Nothing Then
    If IsDate(Target) = True Then
        iRow = 3
        Range("B4:B35").ClearContents
        dDate = CDate(Range("B3").Value)
        'Calcul de la date de Pâques
        iEaster = (((19 * (Year(dDate) Mod 19)) + 24) Mod 30) + _
            ((2 * (Year(dDate) Mod 4)) + (4 * (Year(dDate) Mod 7)) + ((6 * (((19 * (Year(dDate) Mod 19)) + 24) Mod 30)) + 5) Mod 7)
        dEaster = IIf(iEaster <= 9, DateSerial(Year(dDate), 3, iEaster + 22), DateSerial(Year(dDate), 4, iEaster - 9))
        For x = 1 To DateDiff("d", dDate, DateAdd("m", 2, DateSerial(Year(dDate), Month(dDate), 1) - 1))
            iIdx = iIdx + 1
            dNDate = DateAdd("d", iIdx, dDate)
            If Weekday(dNDate, vbMonday) = 4 Or Weekday(dNDate, vbMonday) > 5 Or _
                dNDate = DateSerial(Year(dNDate), 1, 1) Or dNDate = DateSerial(Year(dNDate), 5, 1) Or dNDate = DateSerial(Year(dNDate), 5, 8) Or _
                dNDate = DateAdd("d", 1, dEaster) Or dNDate = DateAdd("d", 39, dEaster) Or dNDate = DateAdd("d", 50, dEaster) Or _
                dNDate = DateSerial(Year(dNDate), 7, 14) Or dNDate = DateSerial(Year(dNDate), 8, 15) Or _
                dNDate = DateSerial(Year(dNDate), 11, 1) Or dNDate = DateSerial(Year(dNDate), 11, 11) Or dNDate = DateSerial(Year(dNDate), 12, 25) Then _
                iRow = iRow + 1: _
                Cells(iRow, 2) = dNDate
        Next
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Ca a l'air de fonctionner nickel avec le code, merci beaucoup.

Je viens d'essayer avec une nouvelle feuille novembre décembre, c'est nickel encore merci

Salut Curulis57, ça marche impec, sauf les lundis de Pâques et Pentecôte qui sont décalés, lundi 28 avril pour Pâques et lundi 16 juin pour la pentecôte. Sinon c'est nickel. Merci beaucoup

Re Salut Curulis57, je remets le fichier, la macro du calendrier avait un souci avec Pâques et Pentecôte, j'ai récupérer le bon code.

Salut Didier,

je l'avais déjà fait une fois et m'étais fait un mal de chien avec ces f... parenthèses.
Malheureusement, je l'ai égaré donc, je me retrouve avec ces f... parenthèses mais ça va aller!

Je reviens plus tard!

A+

Désolé........

Bonsoir,

Avez vous essayé avec "mon code" qui reprend la fonction JourFeries de Stellson déjà comprise dans le fichier d'origine ?

@ bientôt

LouReeD

Bonsoir, oui j'ai répondu que ça fonctionnait bien, j'ai juste le problème que ça m'affiche des dates au delà du tableau, mais pas très important, on peut effacer le contenu.

Merci

Corrigé!
Je vérifie 10.000 fois et je reviens!

Sur cette ligne : Loop While Ligne<41

remplacer le 41 par le numéro de la dernière ligne à remplir.

@ bientôt

LouReeD

Salut Didier, LouReed,

version améliorée où la date en [B3] est automatiquement calculée en fonction du choix de l'année [G1] ou de la période [B1].
Un choix avec le calendrier (inutile à présent) en opposition avec les données ci-dessus ne sera pas pris en compte!
Pour les besoins de la cause, j'ai modifié l'ordre des mois dans 'Rub' : il y a sans doute une raison mais commencer l'énumération par "JANVIER" me semble une évidence!
Attention, si tu modifies cet ordre pour les besoins de TA cause, prière de pardonner la macro qui calculera des dates erronées, forcément

For x = 1 To 2
    If x = 2 Then _
        iIdx = 0: _
        iRow = 3: _
        Range("B4:B35").ClearContents: _
        dDate = CDate(Range("B3").Value)
    For y = 1 To DateDiff("d", dDate, DateAdd("m", 2, DateSerial(iYear, Month(dDate), 1) - 1))
        iIdx = iIdx + 1
        dNDate = DateAdd("d", iIdx, dDate)
        If Weekday(dNDate, vbMonday) = 4 Or Weekday(dNDate, vbMonday) > 5 Or _
            dNDate = DateSerial(Year(dNDate), 1, 1) Or dNDate = DateSerial(Year(dNDate), 5, 1) Or dNDate = DateSerial(Year(dNDate), 5, 8) Or _
            dNDate = DateAdd("d", 1, dEaster) Or dNDate = DateAdd("d", 39, dEaster) Or dNDate = DateAdd("d", 50, dEaster) Or _
            dNDate = DateSerial(Year(dNDate), 7, 14) Or dNDate = DateSerial(Year(dNDate), 8, 15) Or _
            dNDate = DateSerial(Year(dNDate), 11, 1) Or dNDate = DateSerial(Year(dNDate), 11, 11) Or dNDate = DateSerial(Year(dNDate), 12, 25) Then
                If x = 1 Then
                    Range("B3").Value = dNDate
                    Exit For
                Else
                    iRow = iRow + 1: _
                    Range("B" & iRow).Value = dNDate
                End If
        End If
    Next
Next

Si cela ne convient pas, ben, on reviendra à la version 1, no souci!

A+

Salut Curulis57, LouReed, j'ai 2 solutions qui fonctionnent à merveille, un grand merci à vous deux, je vais proposé les 2 agendas à la prochaine réunion, le délégué sportif fera son choix. Curulis57 dans la feuille Rub la colonne lieu est remplie de dates, je la laisse telle quelle et je recrée une nouvelle colonne lieu?. L'ordre des mois n'est pas très important pour moi, c'était juste que l'on commence notre saison sportive le 15 septembre, ne me demandez pas pourquoi, plus personne ne sait, mais maintenant, c'est trop compliqué de revenir à l'année civile, que ce soit sportivement ou pour la compta.

Encore merci

Salut Didier,

oui, je vois ça! Pige pas trop d'où ça vient!
Bon, j'ai corrigé et apporté un truc en plus.
Le fichier ouvre la feuille correspondant au mois en cours à l'ouverture.

Private Sub Workbook_Open()
'
Dim iIdx%
'
iIdx = Int(Month(Date) / 2) - Month(Date) Mod 2
For x = 1 To Sheets.Count
    If InStr([MOIS_MAJ].Cells(iIdx, 1), Sheets(x).Name) > 0 Then _
        Sheets(x).Activate: _
        Exit For
Next
'
End Sub

J'ai bien d'autres idées mais, laissons aller pour l'instant.

A+

Avec cette version, on est pas mal du tout. J'ai regardé pour mettre une couleur pour les jours fériés avec la MFC, simple pour les les jours fixes mais pour les jours variables??? Peut-être avec formule cellules non vide sans couleur...... mais je bloque