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

[Smookie]

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.

 

[sylvanu]

Bonjour Smookie,
Un essai en PJ avec :

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

 

[Smookie]

Bonjour Smookie,
Un essai en PJ avec :

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.

 

[sylvanu]

c'est au niveau de la mise en page qui se décale à chaque fois...

Vous pouvez être plus explicite ? Quel décalage ?

 

[Smookie]

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

 

[sylvanu]

Oups ! J'avais testé les 3 premiers mois.
En PJ c'est rectifié, enfin pour ce bug là.

If x <= 0 Then ligne = 5 Else ligne = x + 5 ' Ligne pour le 1er du mois

 

[Smookie]

Oups ! J'avais testé les 3 premiers mois.
En PJ c'est rectifié, enfin pour ce bug là.

If x <= 0 Then ligne = 5 Else ligne = x + 5 ' Ligne pour le 1er du mois

Merci !! c'est parfait!! tout fonctionne très bien!!