XL 2019 Fonction calendrier - Insérer un mois et une année pour faire apparaitre les dates du mois entier

Smookie

XLDnaute Nouveau
Bonjour,

Suite à une précédente discussion, un membre du forum m'a réaliser un code VBA pour faire fonctionner mon calendrier automatique.

Je souhaiterai modifier le code afin qu'il affiche tous les 1er du mois (sans compter les week-ends) car j'ai rencontré un problème avec le mois de février en effet le code actuel fait commencé le calendrier à partir 7 (car le 1er tombe sur un mardi) et comme les feuilles d'heures sont au mois la première semaine à sauté, avez-vous une solution s'il vous plait ?

De plus, comme suggérer j'ai ajouté une cellule pour renseigner l'année, est-il possible de lié le code avec l'année ?

Merci infiniment.
 

Pièces jointes

  • test.xlsm
    30.7 KB · Affichages: 12

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Smookie,
Un essai en PJ avec :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$P$1" Then
        Application.ScreenUpdating = False
        Range("A5:C29").ClearContents
        x = Weekday(CDate("01/" & Target.Value & "/" & [V1])) - 2
        ligne = x + 5   ' Ligne pour le 1er du mois
        x = CDate("01/" & Target.Value & "/" & [V1])
        mois = Month(x) ' Mois demandé
        While Month(x) = mois   ' Tant que mois=mois demandé
             If Month(x) = mois Then
                If Weekday(x) <> 1 And Weekday(x) <> 7 Then
                    Range("A" & ligne) = Format(x, "dddd dd/mm/yyyy")
                    ligne = ligne + 1
                End If
            End If
            x = x + 1
        Wend
    End If
End Sub
 

Pièces jointes

  • test (18).xlsm
    24.6 KB · Affichages: 10

Smookie

XLDnaute Nouveau
Bonjour Smookie,
Un essai en PJ avec :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$P$1" Then
        Application.ScreenUpdating = False
        Range("A5:C29").ClearContents
        x = Weekday(CDate("01/" & Target.Value & "/" & [V1])) - 2
        ligne = x + 5   ' Ligne pour le 1er du mois
        x = CDate("01/" & Target.Value & "/" & [V1])
        mois = Month(x) ' Mois demandé
        While Month(x) = mois   ' Tant que mois=mois demandé
             If Month(x) = mois Then
                If Weekday(x) <> 1 And Weekday(x) <> 7 Then
                    Range("A" & ligne) = Format(x, "dddd dd/mm/yyyy")
                    ligne = ligne + 1
                End If
            End If
            x = x + 1
        Wend
    End If
End Sub
Merci pour votre temps, le code fonctionne bien par contre c'est au niveau de la mise en page qui se décale à chaque fois... existe-t-il une solution ? Encore merci.
 

Smookie

XLDnaute Nouveau
Vous pouvez être plus explicite ? Quel décalage ?
Lorsque je change de mois par exemple en mai les dates se décale dans le haut du tableau en supprimant l'entête du tableau
1646150361113.png
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510