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

Smookie · 1 Mars 2022

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 · 1 Mars 2022

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

Smookie · 1 Mars 2022

sylvanu à dit:

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.

sylvanu · 1 Mars 2022

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

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

Smookie · 1 Mars 2022

sylvanu à dit:
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 · 1 Mars 2022

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

VB:

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

Smookie · 1 Mars 2022

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

VB:

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!!

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

Smookie

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Smookie

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Smookie

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Smookie

XLDnaute Nouveau

Discussions similaires