Microsoft 365 VBA Calendrier, rien ne se passe.

E

Eiwinnd

XLDnaute Nouveau
Bonjour à tous !

Je reviens vers vous aujourd'hui car après avoir réussi avec l'aide de @JHA et @TooFatBoy a remplir mes rapport de quart, je me suis mis en tête de me vérifier mes fiches de paie a l'aide d'excel.
Je m'explique :
A chaque quart, nous avons des primes, de salissure, de repas, d'incommodité, de nuit, de week-end etc etc malheureusement notre service compta doit avoir des soucis avec les chiffres car nous ne trouvons jamais le résultat eux et nous !

Du coup je me suis dit que j'allais le faire avec Excel, j'ai d'abord essayer de m'afficher un calendrier a l'aide de formules simple et ChatGPT,
J'ai réussi a avoir en colonne A les jours de l'année, et en colonne B mon cycle de travail.
j'ai essayer quelques calculs simple, et je me suis rendu compte que ca ne marcherait pas (ou que je ne saurais pas le faire) car en essayant de compter les jours qui sont des jours ouvrable (du lundi au vendredi) le format de date renseigné en A1 ne fonctionnerait pas, car c'est une formule étirée.

Je me suis donc tourné vers le VBA et j'ai bosser la dessus (toujours avec l'aide de ChatGPT, je n'y connais rien moi-même)
Concrètement ce que je souhaite faire, c'est m'afficher un calendrier annuel a partir de A3 avec mon cycle de travail dedans. (un peu comme mon planning sur l'image que je joint, juste les jours blanc sur l'image doivent etre grisé avec la mention "Repos") mais je dois pouvoir modifier les jours en question - Par exemple si je suis en congé ou en AM etc -
Il me faudrait pouvoir modifier l'année a volonté et que les jours fériés soient compris dedans.
Ceci afin que je puisse recouper les informations voulues a savoir :
Sur une période d'un mois (dates glissantes, parfois on est payé sur une période du 1er au 31 parfois, du 1er au 25 etc il me faudra ajuster en fonction), le nombre de fois ou j'ai travailler un jour ouvrable, le nombre de fois ou j'ai travaillé un samedi ou dimanche, le nombre de fois ou j'ai travailler de nuit le samedi ou dimanche, le nombre de jour total travaillés, le nombre de jour travaillé un jour férié.

Ca c'est l'idée du projet fini, ma premiere question est : est-ce que c'est possible en VBA ?

Ensuite voici le code sur lequel on a travaillé avec ChatGPT, tous ce que j'ai décris plus haut n'y est pas encore, j'y vais petit a petit.
Code: 
Sub AfficherCalendrier()
    Dim year As Integer
    Dim calendarSheet As Worksheet
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim currentRow As Integer
    Dim currentColumn As Integer
    
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
    Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
    If calendarSheet Is Nothing Then
        Set calendarSheet = ThisWorkbook.Sheets.Add
        calendarSheet.Name = "Calendrier"
    End If
    
    ' Effacer le contenu de la feuille "Calendrier"
    calendarSheet.Cells.ClearContents
    
    ' Créer la validation des données pour le menu déroulant de l'année
    With calendarSheet.Range("A2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="2022,2023,2024" ' Modifier la liste des années ici
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    ' Demander à l'utilisateur de sélectionner l'année
    On Error Resume Next
    year = calendarSheet.Range("A2").Value
    On Error GoTo 0
    
    ' Vérifier si l'année a été spécifiée
    If year <> 0 Then
        ' Calculer la date de début et de fin pour l'année spécifiée
        startDate = DateSerial(year, 1, 1)
        endDate = DateSerial(year, 12, 31)
        
        ' Afficher les jours de la semaine dans la première ligne
        calendarSheet.Range("B1:H1").Value = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
        
        ' Initialiser les variables de position
        currentRow = 3 ' Commencer à la ligne 3
        currentColumn = 2
        
        ' Boucle pour afficher les dates de chaque mois
        Dim mois As Integer
        For mois = 1 To 12
            ' Calculer la date de début et de fin pour le mois
            startDate = DateSerial(year, mois, 1)
            endDate = DateSerial(year, mois + 1, 0)
            
            ' Afficher le nom du mois
            calendarSheet.Cells(currentRow, currentColumn).Value = Format(startDate, "mmmm")
            
            ' Passer à la prochaine colonne
            currentColumn = currentColumn + 1
            
            ' Réinitialiser la colonne si nécessaire
            If currentColumn > 8 Then
                currentColumn = 2
            End If
            
            ' Afficher les dates du mois
            currentDate = startDate
            
            Do While currentDate <= endDate
                ' Vérifier si la date est un lundi
                If Weekday(currentDate, vbMonday) = 2 Then ' Modifier pour lundi
                    ' Passer à la prochaine ligne
                    currentRow = currentRow + 1
                End If
                
                ' Afficher la date dans la cellule correspondante
                calendarSheet.Cells(currentRow, currentColumn).Value = Format(currentDate, "dd")
                
                ' Passer à la prochaine colonne
                currentColumn = currentColumn + 1
                
                ' Réinitialiser la colonne et la ligne si nécessaire
                If currentColumn > 8 Then
                    currentColumn = 2
                End If
                If Weekday(currentDate, vbMonday) = 7 Then ' Modifier pour dimanche
                    currentRow = currentRow + 1
                End If
                
                ' Passer à la prochaine date
                currentDate = currentDate + 1
            Loop
        Next mois
        
        ' Mettre en forme la feuille "Calendrier" pour une meilleure lisibilité
        calendarSheet.Columns.AutoFit
        calendarSheet.Rows.AutoFit
        calendarSheet.Cells.HorizontalAlignment = xlCenter
        
        ' Activer la feuille "Calendrier"
        calendarSheet.Activate
    End If
End Sub

Lorsque je l'execute, j'ai bien une nouvelle feuille "calendrier" qui se crée, j'ai bien ne A2 un menu deroulant dans lequel je peut sélectionner une année entre 2022 et 2024 mais rien d'autres.
Aucun calendrier, toutes les cellules sont vide et excel ne me retourne aucune erreur.
Du coup je en sais pas vraiment si c'est le code qui ne fonctionne pas, ou si c'est un parametre d'excel qui ne va pas.

Version d'excel : Microsoft® Excel® pour Microsoft 365 MSO (Version 2305 Build 16.0.16501.20074) 64 bits

Est-ce que quelqu'un a une idée ?
D'avance merci,
Eiwinnd
Planning test.jpg
 
Trier par date Trier par votes
E

Eiwinnd

XLDnaute Nouveau
fanch55 à dit:
Bonjour,
Exemple de Code modifié dans le classeur joint .
Cliquez pour agrandir...
J'ai travailler un peu dessus, et j'ai reussi a faire en sorte que les jours soient colorisé en fonction de mon planning, suivant un code couleur specifique.
en revanche, je n'arrive pas a avoir l'année dans le menu deroulant en A2, il commence systematiquement en 2023 et ne me propose pas d'autres années. Si je supprime l'année a la main excel m'affiche une erreur "Erreur d'execution '9' : L'indice n'appartient pas a la selection" je n'arrive pas a trouver d'ou cela vient.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

@Eiwinnd
Juste pour test
Sur une feuille vierge, ce test fonctionne
Code: 
Sub test_validation()
    With Range("A2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="2022,2023,2024,2025"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With
End Sub
C'est le même code que dans ton code

Il n'y a pas des procédures évènementielles dans la feuille par hasard ?
(dans le code de la feuille, pas dans un module)
 
Vote positif 0 Vote négatif
E

Eiwinnd

XLDnaute Nouveau
Staple1600 à dit:
Bonsoir le fil,

@Eiwinnd
Juste pour test
Sur une feuille vierge, ce test fonctionne
Code: 
Sub test_validation()
    With Range("A2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="2022,2023,2024,2025"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With
End Sub
C'est le même code que dans ton code

Il n'y a pas des procédures évènementielles dans la feuille par hasard ?
(dans le code de la feuille, pas dans un module)
Cliquez pour agrandir...
de procedure evenementielle ? Type quand je change l'année le calendrier change également en se mettant a jour ? Parce que sinon, je ne vois que ca.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Si tu fais un clic-droit sur l'onglet Calendrier -> Visualiser le code
Est-ce que tu vois du code VBA à droite de l'écran
(C'est ici que sont stockées les procédures évènementielles)

Le classeur fourni par fanch55 fonctionne

C'est seulement sur ton propre classeur que le problème apparait, non ?
 
Vote positif 0 Vote négatif
E

Eiwinnd

XLDnaute Nouveau
Staple1600 à dit:
Re

Si tu fais un clic-droit sur l'onglet Calendrier -> Visualiser le code
Est-ce que tu vois du code VBA à droite de l'écran
(C'est ici que sont stockées les procédures évènementielles)

Le classeur fourni par fanch55 fonctionne

C'est seulement sur ton propre classeur que le problème apparait, non ?
Cliquez pour agrandir...
si je fais clic droit => examiner le code, il m'ouvre l'editeur VBA et 3 fenetres pop up dedans, je te copie le code de chacune d'entre elle :

1 :


VB: 
Option Explicit

Private Sub Workbook_Open()
    Dim calendarSheet As Worksheet
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
        Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
    
    If calendarSheet Is Nothing Then
        ' Créer la validation des données pour le menu déroulant de l'année
        Set calendarSheet = ThisWorkbook.Sheets.Add
        With calendarSheet
            .Name = "Calendrier"
            With .Range("A2")
                ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "Cbx_An"
            End With
            [Cbx_An].Object.Font.Size = 8
            
            ' Remplir la liste des années entre 2020 et 2030 dans le menu déroulant
            Dim i As Integer
            For i = 2020 To 2030
                [Cbx_An].Object.AddItem CStr(i)
            Next i
        End With
    End If

End Sub

Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

2 :


Code: 
Sub Cbx_An_Has_Changed()
    Dim Cal_An As Integer
    Dim startDate As Date
    Dim EndDate As Date
    Dim currentRow As Long
    Dim icol As Long
    Dim icol_Odd As Long
    Dim icol_even As Long
    Dim currentDate As Date
    
    Cal_An = [Cbx_An].Object.Value
    ' Vérifier si l'année a été spécifiée
    If Cal_An <> 0 Then
        Cells.Clear
        ' Afficher les jours de la semaine en ligne 2
        With Range("B2").Resize(, 7)
            .Value = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
            .Interior.Color = vbBlack
            .Font.Color = vbWhite
        End With
        
        currentRow = 3 ' Commencer à la ligne 3
        icol_Odd = 16247773
        icol_even = 15123099
        
        ' Boucle pour afficher les dates de chaque mois
        Dim mois As Integer
        For mois = 1 To 12
            icol = IIf(mois Mod 2 = 0, icol_Odd, icol_even)
            ' Calculer la date de début et de fin pour le mois
            startDate = DateSerial(Cal_An, mois, 1)
            EndDate = DateSerial(Cal_An, mois + 1, 0)
            
            ' Afficher le nom du mois
            With Cells(currentRow, 1)
                .Value = Format(startDate, "mmmm")
                .Interior.Color = icol
            End With
            
            ' Afficher les dates du mois
            currentDate = startDate
            Do While currentDate <= EndDate
                With Cells(currentRow, Weekday(currentDate, vbMonday) + 1)
                    .Value = Format(currentDate, "dd")
                    
                    ' Colorer les jours de travail selon le cycle
                    Select Case GetWorkCycle(currentDate)
                        Case "Matin"
                            .Interior.Color = RGB(255, 0, 0) ' Rouge
                        Case "Après-midi"
                            .Interior.Color = RGB(146, 208, 80) ' Vert
                        Case "Nuit"
                            .Interior.Color = RGB(0, 176, 240) ' Bleu
                        Case "Repos"
                            .Interior.Color = RGB(192, 192, 192) ' Gris
                    End Select
                End With
                
                If Weekday(currentDate, vbMonday) = 7 Then
                    If currentDate < EndDate Then currentRow = currentRow + 1
                End If
                
                ' Passer à la prochaine date
                currentDate = currentDate + 1
            Loop
            currentRow = currentRow + 1
        Next mois
        
        ' Mettre en forme la feuille "Calendrier" pour une meilleure lisibilité
        Columns.AutoFit
        Rows.AutoFit
        Cells.HorizontalAlignment = xlCenter
        
    End If
End Sub

Function GetWorkCycle(dateValue As Date) As String
    ' Récupérer le cycle de travail en fonction de la date
    Dim startDate As Date
    Dim daysPassed As Long
    Dim cycleIndex As Integer
    Dim cycles As Variant
    
    startDate = DateSerial(2022, 12, 29) ' Date de début du cycle
    
    ' Définir les cycles de travail
    cycles = Array("Matin", "Matin", "Après-midi", "Après-midi", "Nuit", "Nuit", "Repos", "Repos", "Repos", "Repos")
    
    daysPassed = dateValue - startDate
    cycleIndex = daysPassed Mod 10
    
    GetWorkCycle = cycles(cycleIndex)
End Function

3:


Code: 
Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

J'espere que cela t'aidera.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Donc il y a des procédures évènementielles
Elles sont dans ton classeur ou dans celui de fanch55 ?


J'ai testé seulement cette procédure
(dans un classeur vierge)
Comme son l'indique elle se lance à l'ouverture du classeur
Enrichi (BBcode): 
Option Explicit
Private Sub Workbook_Open()
    Dim calendarSheet As Worksheet
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
        Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
    
    If calendarSheet Is Nothing Then
        ' Créer la validation des données pour le menu déroulant de l'année
        Set calendarSheet = ThisWorkbook.Sheets.Add
        With calendarSheet
            .Name = "Calendrier"
            With .Range("A2")
                ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "Cbx_An"
            End With
            [Cbx_An].Object.Font.Size = 8
            
            ' Remplir la liste des années entre 2020 et 2030 dans le menu déroulant
            Dim i As Integer
            For i = 2020 To 2030
                [Cbx_An].Object.AddItem CStr(i)
            Next i
        End With
    End If

End Sub
Et comme tu le vois, elle créé une ComboBox qui va de 2020 à 2030.

Tu n'utilises plus le code de ton message#1 où tu créés une validation aussi en A2 ?
 
Vote positif 0 Vote négatif
E

Eiwinnd

XLDnaute Nouveau
Staple1600 à dit:
Re

Donc il y a des procédures évènementielles
Elles sont dans ton classeur ou dans celui de fanch55 ?


J'ai testé seulement cette procédure
(dans un classeur vierge)
Comme son l'indique elle se lance à l'ouverture du classeur
Enrichi (BBcode): 
Option Explicit
Private Sub Workbook_Open()
    Dim calendarSheet As Worksheet
    ' Vérifier si la feuille "Calendrier" existe, sinon la créer
    On Error Resume Next
        Set calendarSheet = ThisWorkbook.Sheets("Calendrier")
    On Error GoTo 0
  
    If calendarSheet Is Nothing Then
        ' Créer la validation des données pour le menu déroulant de l'année
        Set calendarSheet = ThisWorkbook.Sheets.Add
        With calendarSheet
            .Name = "Calendrier"
            With .Range("A2")
                ActiveSheet.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, _
                DisplayAsIcon:=False, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Name = "Cbx_An"
            End With
            [Cbx_An].Object.Font.Size = 8
          
            ' Remplir la liste des années entre 2020 et 2030 dans le menu déroulant
            Dim i As Integer
            For i = 2020 To 2030
                [Cbx_An].Object.AddItem CStr(i)
            Next i
        End With
    End If

End Sub
Et comme tu le vois, elle créé une ComboBox qui va de 2020 à 2030.

Tu n'utilises plus le code de ton message#1 où tu créés une validation aussi en A2 ?
Cliquez pour agrandir...
non, en effet je n'utilise plus mon classeur, j'ai retravaillé a partir de celui de Fanch.
je te joint le fichier.
 

Pièces jointes

  • 001.xlsm
    31.4 KB · Affichages: 10
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

1) J'ai supprime la feuille Calendrier
2) J'ai exécuté la macro WorkBook_Open()
3) J'ai copié cette procédure dans la feuille Calendrier
(clic-droit -> Visualiser le code)
VB: 
Private Sub Cbx_An_Change()
    Cbx_An_Has_Changed
End Sub

Désormais ton calendrier refonctionne
(en tout cas, c'est le cas sur mon PC.)
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Le code que j'avais mis dans le Thisworkbook était pour rester dans la même démarche que le code fourni.
Le classeur ne fonctionnera pas si la feuille Calendrier est supprimée et que vous ne laissez pas le code d'écriture du VBE .
VB: 
            With VBProject.VBComponents(.CodeName).CodeModule
                .InsertLines .CountOfLines + 1, "Private Sub Cbx_An_Change()"
                .InsertLines .CountOfLines + 1, "    Cbx_An_Has_Changed"
                .InsertLines .CountOfLines + 1, "End Sub"
            End With

Ceci dit, c'était juste un exercice pour le fun .
A mon avis, la feuille Calendrier n'a pas vocation a être détruite.
Donc, le plus approprié serait de supprimer tout le code dans Thisworkbook et dans Module1
et de tout mettre dans le module Calendrier, ce qui donne le classeur joint ...
( la liste des années est dynamique d'année en cours - 2 à année en cours + 8 )
 

Pièces jointes

  • Eiwind_F55.xlsm
    30.4 KB · Affichages: 10
Vote positif 0 Vote négatif

Discussions similaires

G
  • Résolu(e)
XL 2021 VBA dates au mauvais format
Réponses
5
Affichages
250
vgendron
vgendron
P
  • Question
XL 2013 Calendrier
Réponses
8
Affichages
387
AR MOR
A
Nicolas JACQUIN
  • Résolu(e)
XL 2021 calcul de l'heure quand le soleil est au Zénith
3 4 5
Réponses
64
Affichages
2 K
dysorthographie
dysorthographie
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
59
JJ69
J
Etoto
  • Résolu(e)
Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique
Réponses
11
Affichages
220
Etoto
Etoto
K
  • Question
Microsoft 365 création mot passe classique avec un code
Réponses
1
Affichages
266
Gégé-45550
Gégé-45550
F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
Oneida
M
  • Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
348
Maxou69
M
B
  • Résolu(e)
Microsoft 365 Problème dans formule VBA
Réponses
7
Affichages
199
BOILEAU
B
S
  • Question
XL 2019 Calculer dimanche de pâques puis insertion du 29 février
2
Réponses
26
Affichages
302
dysorthographie
dysorthographie

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 74 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 083
Membres
112 655
dernier inscrit
fannycordi