Microsoft 365 datepicker dynamique intra userform(frame dynamique)(toute version d'excel )

patricktoulon · Jeudi à 19:15

Bonjour à tous
suite a ta demande en Mp @JCabral j'ai ressorti mes archives
j'ai du ré ouvrir pas mal de zip pour le retrouver 🤪 🤪
j'ai bien entendu fait un peu de restructuration du code en effet il datait un peu
alors voila mon module classe pour avoir un calendar dynamique dans un userform et non un userform calendar en mode responsif comme ma ressource du même nom

cette classe va créer de toute pièce l'interface du calendrier a l’intérieur du userform
il n'y a pas de librairie particulière à activer
un module classe nommé:Dynamic_Calendrier

VB:

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Interface calendrier dans frame dynamique pour Userform By patricktoulon
'' Copyright (C) 2025
'' auteur:Patrick Verne sur developpez.com
'' Date version:22/06/2013
'' Mise à jour:
'' remastering complet du code version 2025
'' publié sur exceldownloads

Option Explicit

Dim cl(1 To 42) As New Dynamic_Calendrier
Public Datepicker As Object
Public WithEvents cbm As msforms.ComboBox
Public WithEvents cba As msforms.ComboBox
Public WithEvents Bt As msforms.Label
Public u As Object
Public cla As Dynamic_Calendrier '
Public CallerControl As Object
'--------------------------------
'Changez les couleurs ici
Const BackgroundColor = &HDACCC9
'les combobox
Const comboBackColor = &H808080
Const comboFontColor = vbYellow
'les titres de jour
Const headerBackColor = vbBlue
Const headerfontColor = vbYellow
'les jour de la semaine
Const DayBackColor = vbWhite
Const DayfontColor = vbBlue
'les jour weekend
Const WeekendBackColor = vbYellow
Const WeekendfontColor = vbRed
'les jour weekend
Const fériéBackColor = vbGreen
Const fériéfontColor = vbRed
'--------------------------------

Public Sub InitCalendar(uf)
    'Plaque du calendrier(frame
    Dim f, cbmois, cbyear, I&, B, T, E
    Set f = uf.Controls.Add("forms.Frame.1", "Calendar", True)
    Set Datepicker = f
    With f
        .Width = 150
        .Height = 120
        .Top = 10
        .Caption = ""
        .BackColor = &HDACCC9
        'combobox des mois
        Set cbmois = f.Add("forms.ComboBox.1", "cbmois", True)
        With cbmois
            .List = Application.GetCustomListContents(3)
            .Height = 15
            .ListRows = 12
            .Width = 50
            .Font.Bold = True
            Set cbm = cbmois
            Set u = uf
            cbmois.BackColor = comboBackColor
            cbmois.ForeColor = comboFontColor
        End With
      
        'combobox des années
        Set cbyear = f.Add("forms.ComboBox.1", "cbyear", True)
        With cbyear
            .List = Evaluate("row(1900:2050)")
            .Height = 15
            .ListRows = 12
            .Left = 85
            .Width = 50
            .Font.Bold = True
            Set cba = cbyear
            cbyear.BackColor = comboBackColor
            cbyear.ForeColor = comboFontColor
            .MatchEntry = 0
        End With
      
        'header de calendrier(les jours de semaines
        Dim jours As Variant, j As Variant
        jours = Application.GetCustomListContents(1)
        For Each j In jours
            Debug.Print j
            I = I + 1
            Set B = f.Add("forms.label.1", Left(j, 3) & "_", True)
            With B
                .Caption = Left(j, 3)
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (I - 1)
                .TextAlign = 2
                .Top = 20
                .BackColor = headerBackColor
                .ForeColor = headerfontColor
                .Font.Bold = True
            End With
        Next j
      
        'les 42 positions de jours possibles
        T = 34
        For I = 1 To 42
            E = E + 1
            Set B = f.Add("forms.label.1", "j" & I, True)
            With B
                .Caption = "-"
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (E - 1)
                .Top = T
                If E = 7 Then E = 0: T = T + 14
                .TextAlign = 2
                Set cl(I).Bt = B: Set cl(I).cbm = cbmois: Set cl(I).cba = cbyear: Set cl(I).u = uf
                Set cl(I).cla = Me: Set cl(I).Datepicker = f
            End With
        Next
    End With
    f.Visible = False
End Sub

Private Sub Bt_Click()
    'MsgBox DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    cla.CallerControl = DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    Datepicker.Visible = False
  
End Sub

Private Sub cba_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub

Private Sub cbm_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub

Sub reloadmonth()
    Dim d As Date, fin, X&, I&, E&
    d = DateSerial(cba, cbm.ListIndex + 1, 1)
    fin = Day(DateSerial(cba.Value, cbm.ListIndex + 2, 0))
    X = Weekday(d, vbUseSystemDayOfWeek)
    For I = 1 To 42
        With u.Controls("j" & I)
            .Caption = "-"
            .BackStyle = 0
            .ForeColor = vbBlack
        End With
    Next
    For I = X To X + fin - 1
        E = E + 1
        With u.Controls("j" & I)
            .BackStyle = 1
            .Caption = Day(d + (E - 1))
          
            .BackColor = DayBackColor
            .ForeColor = DayfontColor
          
            If Weekday(d + (E - 1), 2) >= 6 Then
                .BackColor = WeekendBackColor
                .ForeColor = WeekendfontColor
            End If
          
            If férié(d + (E - 1)) Then
                .BackColor = fériéBackColor
                .ForeColor = fériéfontColor
            End If
        End With
    Next
End Sub
Public Sub ShowCalendar(ctrl As Object)
    With Datepicker
        .Visible = True
        .Left = ctrl.Left + ctrl.Width
        .Top = ctrl.Top
    End With
    If IsDate(ctrl.Value) Then
        Dim A&, M&
        A = Year(CDate(ctrl.Value))
        M = Month(CDate(ctrl.Value)) - 1
    Else
        A = Year(Date): M = Month(Date) - 2
    End If
    cba.Value = A: cbm.ListIndex = M:
    cba.ListIndex = A - 1900
    reloadmonth
    Set Me.CallerControl = ctrl
End Sub
Function férié(d As Date) As Boolean
    férié = False
    Dim tbl(1 To 12) As Date, I&
    tbl(1) = DateSerial(Year(d), 1, 1)
    tbl(2) = CDate(((Round(DateSerial(Year(d), 4, (234 - 11 * (Year(d) Mod 19)) Mod 30) / 7, 0) * 7) - 6))
    tbl(3) = tbl(2) + 39
    tbl(4) = tbl(2) + 50
    tbl(5) = DateSerial(Year(d), 5, 1)
    tbl(6) = DateSerial(Year(d), 5, 8)
    tbl(7) = DateSerial(Year(d), 11, 11)
    tbl(8) = DateSerial(Year(d), 12, 25)
     tbl(9) = tbl(2) + 1
 For I = 1 To UBound(tbl)
        If (d) = (tbl(I)) Then férié = True: Exit For
    Next
End Function

exemple d'utilisation dans un userform

Code:

Dim cls As New Dynamic_Calendrier

Private Sub UserForm_Initialize()
    cls.InitCalendar Me
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
        cls.ShowCalendar TextBox1
    End If
End Sub

Les couleur peuvent être changée au niveau des constantes

VB:

'--------------------------------
'Changez les couleurs ici
Const BackgroundColor = &HDACCC9
'les combobox
Const comboBackColor = &H808080
Const comboFontColor = vbYellow
'les titres de jour
Const headerBackColor = vbBlue
Const headerfontColor = vbYellow
'les jour de la semaine
Const DayBackColor = vbWhite
Const DayfontColor = vbBlue
'les jour weekend
Const WeekendBackColor = vbYellow
Const WeekendfontColor = vbRed
'les jour weekend
Const fériéBackColor = vbGreen
Const fériéfontColor = vbRed
'--------------------------------

voila par de fenêtre calendar en plus mais le calendar est à l'intérieur du userform dans un frame
Patrick

patricktoulon · Vendredi à 21:45

re
oui je suppose que plus d'un ne désire pas le tank "calendar" 🤣 🤣 🤣 dans un userform en modal qui est orienté dialogBox Modal
je le comprends aisément
la on est dans un contexte applicatif
une simple classe qui crée un petit calendrier opérationnel dans notre interface c'est intéressant aussi
perso je me suis trop habitué a mon calendar Modal (dialog(click/réponse)) en 8 (langues/régions)à ce jour

ce qui me trouble le plus c'est de voir comment je faisais il y a 12 ans et maintenant

dysorthographie · Samedi à 13:39

Bonjour Patrick,
Avec un ennumerateur tu n'es pas obligé de décliner.

Code:

 '.BackColor=CalendarColors.headerBackColor
.BackColor=headerBackColor

patricktoulon · Samedi à 14:32

Bonjour robert
tu en est sur????????????????????

dysorthographie · Samedi à 14:36

patricktoulon à dit:
Bonjour robert
tu en est sur????????????????????

Oui. Tu avais juste a modifier tes déclarations en enum sans modifier l'utilisation de tes constantes dans ton code

Code:

Enum Couleurs
    Rouge = 1
    Vert = 2
    Bleu = 3
End Enum

Sub test()
Dim A As Integer
A = Rouge
Couleur Vert
End sub
Sub Couleur(c as couleurs)
Msgbox c
End Sub

En plus en paramètre tu gagnes l'inscription intuitive.

patricktoulon · Samedi à 14:53

Robert je te rappelle que l'on est dans un module classe
essaie donc dans un module de classe 😉

dysorthographie · Samedi à 14:58

patricktoulon à dit:
Robert je te rappelle que l'on est dans un module classe
essaie donc dans un module de classe 😉

Autant pour moi j'ai zappé ce détail 🥵 qui n'en est pas un là

J'ai tellement l'habitude d'utiliser des ennumerateur dans des modules de classe que j'oublie que ce n'est pas possible.

patricktoulon · Samedi à 15:12

et oui on est pas dans un module standard là c'est la différence entre ces deux type de module

module standard

VB:

Enum' sera en public par defaut donc accessible partout dans le classeur
    toto=1
    titi=2
End Enum


sub test
    msgbox titi
end sub

dans une classe la portée dans la declaration est obligatoire
et pour le coup le prefixe aussi

Code:

public Enum truc ' sera en public dans la classe (et les instances de classe
    toto=1
    titi=2
End Enum

sub test
    msgbox truc.titi
end sub

voilà mon petit robert

dysorthographie · Samedi à 15:17

patricktoulon à dit:
et oui on est pas dans un module standard là c'est la différence entre ces deux type de module

module standard

VB:

Enum' sera en public par defaut donc accessible partout dans le classeur toto=1 titi=2 End Enum sub test msgbox titi end sub

dans une classe la portée dans la declaration est obligatoire
et pour le coup le prefixe aussi

Code:

public Enum truc ' sera en public dans la classe (et les instances de classe toto=1 titi=2 End Enum sub test msgbox truc.titi end sub

voilà mon petit robert

et pourtant ça fonctionne dans ton module de classe je viens de le tester

patricktoulon · Samedi à 15:47

re
oui mais il y a 42 instances de classe dans la classe mère
la classe mère instanciée par le userform
et les 42 autres instanciées dans le init de la classe mère(se rappeler de ma classe en poupée russe dans les ressources )
parti de la vba ne considère pas le enum public si ce n'est pas explicitement déclaré
c'est d'ailleurs pour ca que
enum
'...
end enum
déclenche une erreur dans un module classe
chatGpt viens de me le confirmer
et puis il suffit d'essayer pour voir que vba te met le enum en rouge dans un module classe

donc non je répete dans une classe la portée est obligatoire
et comme on le vois bien dans cette capture cidessous la designationl'est aussi

ne pas confondre vb6 voir vb.net et vba 😉
pour le coup là les captures parlent d'elles mêmes

patricktoulon · Samedi à 16:02

et pour le coup j'ajoute la fonction placement
pour le cas ou les textbox ne soient pas les childs directs du userform (herzats de la fonction du calendar)

VB:

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Interface calendrier dans frame dynamique pour Userform By patricktoulon
'' Copyright (C) 2025
'' auteur:Patrick Verne sur developpez.com
'' Date version:22/06/2013
'' Mise à jour:
'' remastering complet du code version 2025
'' publié sur exceldownloads
'' mise à jour 29/08/2025
'' correction des férié
'' bloquage du click sur jours vides
'' Ajout du bouton fermé
'' les couleurs dans un bloc Enum
'' Mise a jour 30/08/2025
'' Ajout du plement du calendrier avec la fonction coordonnee(herzats issue du calendar)
'' Ajout de l'anti depassement du inside post coordonnee

Option Explicit
Dim cl(1 To 42) As New Dynamic_Calendrier
Public Datepicker As Object
Public WithEvents cbm As MSForms.ComboBox
Public WithEvents cba As MSForms.ComboBox
Public WithEvents Bt As MSForms.Label
Public WithEvents btclose As MSForms.Label

Public u As Object
Public cla As Dynamic_Calendrier '
Public CallerControl As Object

'--------------------------------
' Changez les couleurs ici
Public Enum CalendarColors
    BackgroundColor = &HDACCC9
    'les combobox
    comboBackColor = &H808080
    comboFontColor = vbYellow
    'les titres de jour
    headerBackColor = vbBlue
    headerfontColor = vbYellow
    'les jours de la semaine
    DayBackColor = vbWhite
    DayfontColor = vbBlue
    'les jours weekend
    WeekendBackColor = vbYellow
    WeekendfontColor = vbRed
    'les jours fériés
    ferieBackColor = vbGreen
    feriefontColor = vbRed
End Enum
'--------------------------------

Public Sub InitCalendar(uf)
    'Plaque du calendrier(frame
    Dim f, cbmois, cbyear, I&, B, T, E
    Set f = uf.Controls.Add("forms.Frame.1", "Calendar", True)
    Set Datepicker = f
    With f
        .Width = 150
        .Height = 120
        .top = 10
        .Caption = ""
        .BackColor = CalendarColors.BackgroundColor
        '----------------------------------------------------------------------------
        Set B = f.Add("forms.Label.1", "btClose", True)
        With B
            .BackColor = vbRed
            .Caption = "X"
            .ForeColor = vbWhite
            .Font.Bold = True
            .TextAlign = 2
            .Left = f.Width - 15 - 4
            .top = 2
            .Width = 15
            .Height = 12
            Set btclose = B
        End With
        '----------------------------------------------------------------------------
        'combobox des mois
        Set cbmois = f.Add("forms.ComboBox.1", "cbmois", True)
        With cbmois
            .List = Application.GetCustomListContents(3)
            .Height = 15
            .top = 2
            .ListRows = 12
            .Width = 50
            .Font.Bold = True
            Set cbm = cbmois
            Set u = uf
            cbmois.BackColor = CalendarColors.comboBackColor
            cbmois.ForeColor = CalendarColors.comboFontColor
        End With
        '----------------------------------------------------------------------------
        'combobox des années
        Set cbyear = f.Add("forms.ComboBox.1", "cbyear", True)
        With cbyear
            .List = Evaluate("row(1900:2050)")
            .Height = 15
            .top = 2
            .ListRows = 12
            .Left = 65
            .Width = 50
            .Font.Bold = True
            Set cba = cbyear
            cbyear.BackColor = CalendarColors.comboBackColor
            cbyear.ForeColor = CalendarColors.comboFontColor
            .MatchEntry = 0
        End With
        '----------------------------------------------------------------------------
        'header de calendrier(les jours de semaines
        Dim jours As Variant, j As Variant
        jours = Application.GetCustomListContents(1)
        For Each j In jours
            I = I + 1
            Set B = f.Add("forms.label.1", Left(j, 3) & "_", True)
            With B
                .Caption = Left(j, 3)
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (I - 1)
                .TextAlign = 2
                .top = 20
                .BackColor = CalendarColors.headerBackColor
                .ForeColor = CalendarColors.headerfontColor
                .Font.Bold = True
            End With
        Next j
        '----------------------------------------------------------------------------
        'les 42 positions de jours possibles
        T = 34
        For I = 1 To 42
            E = E + 1
            Set B = f.Add("forms.label.1", "j" & I, True)
            With B
                .Caption = "-"
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (E - 1)
                .top = T
                If E = 7 Then E = 0: T = T + 14
                .TextAlign = 2
                Set cl(I).Bt = B: Set cl(I).cbm = cbmois: Set cl(I).cba = cbyear: Set cl(I).u = uf
                Set cl(I).cla = Me: Set cl(I).Datepicker = f
            End With
        Next
    End With
    f.Visible = False
End Sub

Private Sub Bt_Click()
    'MsgBox DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    If Bt.Caption = "-" Then Exit Sub
    cla.CallerControl = DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    Datepicker.Visible = False
    
End Sub

Private Sub cba_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub

Private Sub cbm_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub
Private Sub btclose_Click()
    Datepicker.Visible = False
End Sub

Sub reloadmonth()
    Dim d As Date, fin, X&, I&, E&
    d = DateSerial(cba, cbm.ListIndex + 1, 1)
    fin = Day(DateSerial(cba.Value, cbm.ListIndex + 2, 0))
    X = Weekday(d, vbUseSystemDayOfWeek)
    For I = 1 To 42
        With u.Controls("j" & I)
            .Caption = "-"
            .BackStyle = 0
            .ForeColor = vbBlack
        End With
    Next
    For I = X To X + fin - 1
        E = E + 1
        With u.Controls("j" & I)
            .BackStyle = 1
            .Caption = Day(d + (E - 1))
            
            .BackColor = CalendarColors.DayBackColor
            .ForeColor = CalendarColors.DayfontColor
            
            If Weekday(d + (E - 1), 2) >= 6 Then
                .BackColor = CalendarColors.WeekendBackColor
                .ForeColor = CalendarColors.WeekendfontColor
            End If
            
            If férié(d + (E - 1)) Then
                .BackColor = CalendarColors.ferieBackColor
                .ForeColor = CalendarColors.feriefontColor
            End If
        End With
    Next
End Sub
Public Sub ShowCalendar(ctrl As Object)
    Dim coord
    coord = coordonnee(ctrl)
    With Datepicker
        .Visible = True
        .Left = coord(0) 'ctrl.Left + ctrl.Width
        .top = coord(1) 'ctrl.Top
        'redressement si le calendrier sort du inside de l'userform
        If coord(0) + 150 + 20 > u.InsideWidth Then .Left = u.InsideWidth - .Width - 5
        If coord(1) + Datepicker.Height > u.InsideHeight Then .top = u.InsideHeight - .Height - 5
    End With
    If IsDate(ctrl.Value) Then
        Dim A&, M&
        A = Year(CDate(ctrl.Value))
        M = Month(CDate(ctrl.Value)) - 1
    Else
        A = Year(Date): M = Month(Date) - 2
    End If
    cba.Value = A: cbm.ListIndex = M:
    cba.ListIndex = A - 1900
    reloadmonth
    Set Me.CallerControl = ctrl
End Sub
Function férié(d As Date) As Boolean
    férié = False
    Dim tbl(1 To 12) As Date, I&
    tbl(1) = DateSerial(Year(d), 1, 1)
    tbl(2) = CDate(((Round(DateSerial(Year(d), 4, (234 - 11 * (Year(d) Mod 19)) Mod 30) / 7, 0) * 7) - 6))
    tbl(3) = tbl(2) + 39 'L'Ascension est une fête chrétienne fixée 40 jours après le dimanche de Pâques. Elle symbolise la montée de Jésus vers Dieu
    tbl(4) = tbl(2) + 50 'Les apôtres ont alors dit : « L'Esprit du Seigneur est sur nous ». Elle clôt le temps pascal de 50 jours. La Pentecôte célèbre à la fois le commencement de l'Église, sa fondation, et l'émergence des premières communautés chrétiennes, au Ier siècle.
    tbl(5) = DateSerial(Application.Max(Year(d), 1919), 5, 1) 'Le 23 avril 1919, le Sénat français ratifie la journée de huit heures et fait du 1er mai suivant, à titre exceptionnel, une journée chômée. Depuis, le 1er mai est resté le jour international des revendications ouvrières, donnant lieu à des défilés de travailleurs
    tbl(6) = DateSerial(Application.Max(Year(d), 1945), 5, 8) 'Victoire des forces alliées sur l'Allemagne nazie et fin de la Seconde Guerre mondiale en Europe, le 8 mai 1945 marque une date importante. Pour le 80e anniversaire de la capitulation nazie
    tbl(7) = DateSerial(Application.Max(Year(d), 1919), 11, 11) '11 novembre - Cérémonie commémorative de l'Armistice du 11 novembre 1918, de la Victoire et de la Paix et d'hommage à tous les Morts pour la France
    tbl(8) = DateSerial(Year(d), 12, 25)
    tbl(9) = tbl(2) + 1
    tbl(10) = DateSerial(Year(d), 7, 14) 'Le 14 juillet, pour sa double valeur symbolique, a finalement été privilégié. La prise de la Bastille en 1789 s'impose dans l'imaginaire collectif comme la victoire du peuple sur l'arbitraire royal, un événement adouci par la fête de 1790 et sa dimension fédératrice autour d'un événement commun
    For I = 1 To UBound(tbl)
        If (d) = (tbl(I)) Then férié = True: Exit For
    Next
End Function

Public Function coordonnee(obj As Object)
    'hersats du calendar 5.x
    If Not obj Is Nothing Then
        Dim Lft As Double, top As Double, P As Object, I&
        Lft = obj.Left
        top = obj.top
        Set P = obj.Parent
        If Not P Is u Then
            Do
                If TypeOf P Is MSForms.Page Then Set P = P.Parent
                Lft = Lft + P.Left
                top = top + P.top
                If TypeOf P Is Frame Then
                    top = top + ((P.Height - P.InsideHeight) / 2)
                    Lft = Lft + ((P.Width - P.InsideWidth) / 2)
                End If
                Set P = P.Parent
                If P Is u Then Exit Do
            Loop
            top = top + (u.Height - u.InsideHeight)
        End If
    End If
    coordonnee = Array(Lft + obj.Width, top)
End Function

là c'est bon je crois on a tout

test anti dépassement avec le textbox d'en bas

dysorthographie · Samedi à 16:30

ChatGPT est un abruti il ne réfléchit pas plus loin que le bout de son nez si tu lui tord le bras il te di que tu as raison et de fais faire des connerie!

ChatGpt à dit:
je viens de déclarer un enumérateur en public dans un module de classe et ça fonctionne

ChatGPT a dit :
Exact 👍, en VBA tu peux déclarer un Enum en Public dans un module de classe, et dans ce cas il devient visible à l’extérieur de la classe.

Exemple simple :

' Dans le module de classe MaClasse Public Enum Couleurs Rouge = 1 Vert = 2 Bleu = 3 End Enum 
Et depuis un module standard :

Sub TestEnum() Dim c As Couleurs ' ✅ VBA reconnaît le type c = Rouge Debug.Print c End Sub

Code:

'*****************************************************************************************************
'    ___     _     _______  __      _   ____  _   _  _______  ___     _   _   _    ___     _     _.
'   //  \\  /\\      //    // \\   //  //    //  //    //    //  \\  //  //  //   //  \\  //|   //
'  //___// //__\    //    //__//  //  //    //__//    //    //   // //  //  //   //   // // |  //
' //      //   \\  //    //  \\  //  //    //  \\    //    //   // //  //  //   //   // //  | //
'//      //    // //    //   // //  //___ //    \\  //     \\__// //__//  //___ \\__// //   |//
'****************************************************************************************************
'                            Interface calendrier dans frame dynamique pour Userform By patricktoulon
'' Copyright (C) 2025
'' auteur:Patrick Verne sur developpez.com
'' Date version:22/06/2013
'' Mise à jour:
'' remastering complet du code version 2025
'' publié sur exceldownloads
'' mise à jour 29/08/2025
'' correction des férié
'' bloquage du click sur jours vides
'' Ajout du bouton fermé
'' les couleurs dans un bloc Enum
Option Explicit

Dim cl(1 To 42) As New Dynamic_Calendrier
Public Datepicker As Object
Public WithEvents cbm As MSForms.ComboBox
Public WithEvents cba As MSForms.ComboBox
Public WithEvents Bt As MSForms.Label
Public WithEvents btclose As MSForms.Label

Public u As Object
Public cla As Dynamic_Calendrier '
Public CallerControl As Object
'--------------------------------
' Changez les couleurs ici
Public Enum CalendarColors
    BackgroundColor = &HDACCC9
    'les combobox
    comboBackColor = &H808080
    comboFontColor = vbYellow
    'les titres de jour
    headerBackColor = vbBlue
    headerfontColor = vbYellow
    'les jours de la semaine
    DayBackColor = vbWhite
    DayfontColor = vbBlue
    'les jours weekend
    WeekendBackColor = vbYellow
    WeekendfontColor = vbRed
    'les jours fériés
    ferieBackColor = vbGreen
    feriefontColor = vbRed
End Enum
'--------------------------------

Public Sub InitCalendar(uf)
    'Plaque du calendrier(frame
    Dim f, cbmois, cbyear, I&, B, T, E
    Set f = uf.Controls.Add("forms.Frame.1", "Calendar", True)
    Set Datepicker = f
    With f
        .Width = 150
        .Height = 120
        .Top = 10
        .Caption = ""
        .BackColor = BackgroundColor
      
        Set B = f.Add("forms.Label.1", "btClose", True)
        With B
            .BackColor = vbRed
            .Caption = "X"
            .ForeColor = vbWhite
            .Font.Bold = True
            .TextAlign = 2
            .Left = f.Width - 15 - 4
            .Top = 2
            .Width = 15
            .Height = 12
            Set btclose = B
        End With
              
      
        'combobox des mois
        Set cbmois = f.Add("forms.ComboBox.1", "cbmois", True)
        With cbmois
            .List = Application.GetCustomListContents(3)
            .Height = 15
            .Top = 2
           .ListRows = 12
            .Width = 50
            .Font.Bold = True
            Set cbm = cbmois
            Set u = uf
            .BackColor = comboBackColor
            .ForeColor = comboFontColor
        End With
      
        'combobox des années
        Set cbyear = f.Add("forms.ComboBox.1", "cbyear", True)
        With cbyear
            .List = Evaluate("row(1900:2050)")
            .Height = 15
            .Top = 2
            .ListRows = 12
            .Left = 65
            .Width = 50
            .Font.Bold = True
            Set cba = cbyear
            cbyear.BackColor = comboBackColor
            cbyear.ForeColor = comboFontColor
            .MatchEntry = 0
        End With
      
        'header de calendrier(les jours de semaines
        Dim jours As Variant, j As Variant
        jours = Application.GetCustomListContents(1)
        For Each j In jours
            Debug.Print j
            I = I + 1
            Set B = f.Add("forms.label.1", Left(j, 3) & "_", True)
            With B
                .Caption = Left(j, 3)
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (I - 1)
                .TextAlign = 2
                .Top = 20
                .BackColor = headerBackColor
                .ForeColor = headerfontColor
                .Font.Bold = True
            End With
        Next j
      
        'les 42 positions de jours possibles
        T = 34
        For I = 1 To 42
            E = E + 1
            Set B = f.Add("forms.label.1", "j" & I, True)
            With B
                .Caption = "-"
                .Width = 20
                .BorderStyle = 1
                .Height = 12
                .Left = (.Width + 1) * (E - 1)
                .Top = T
                If E = 7 Then E = 0: T = T + 14
                .TextAlign = 2
                Set cl(I).Bt = B: Set cl(I).cbm = cbmois: Set cl(I).cba = cbyear: Set cl(I).u = uf
                Set cl(I).cla = Me: Set cl(I).Datepicker = f
            End With
        Next
    End With
    f.Visible = False
End Sub

Private Sub Bt_Click()
    'MsgBox DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    If Bt.Caption = "-" Then Exit Sub
    cla.CallerControl = DateSerial(cba, cbm.ListIndex + 1, Bt.Caption)
    Datepicker.Visible = False
  
End Sub


Private Sub cba_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub

Private Sub cbm_Change()
    If cbm.ListIndex = -1 Or cba.ListIndex = -1 Then Exit Sub
    reloadmonth
End Sub
Private Sub btclose_Click()
 Datepicker.Visible = False
End Sub

Sub reloadmonth()
    Dim d As Date, fin, X&, I&, E&
    d = DateSerial(cba, cbm.ListIndex + 1, 1)
    fin = Day(DateSerial(cba.Value, cbm.ListIndex + 2, 0))
    X = Weekday(d, vbUseSystemDayOfWeek)
    For I = 1 To 42
        With u.Controls("j" & I)
            .Caption = "-"
            .BackStyle = 0
            .ForeColor = vbBlack
        End With
    Next
    For I = X To X + fin - 1
        E = E + 1
        With u.Controls("j" & I)
            .BackStyle = 1
            .Caption = Day(d + (E - 1))
          
            .BackColor = DayBackColor
            .ForeColor = DayfontColor
          
            If Weekday(d + (E - 1), 2) >= 6 Then
                .BackColor = WeekendBackColor
                .ForeColor = WeekendfontColor
            End If
          
            If férié(d + (E - 1)) Then
                .BackColor = ferieBackColor
                .ForeColor = feriefontColor
            End If
        End With
    Next
End Sub
Public Sub ShowCalendar(ctrl As Object)
    With Datepicker
        .Visible = True
        .Left = ctrl.Left + ctrl.Width
        .Top = ctrl.Top
    End With
    If IsDate(ctrl.Value) Then
        Dim A&, M&
        A = Year(CDate(ctrl.Value))
        M = Month(CDate(ctrl.Value)) - 1
    Else
        A = Year(Date): M = Month(Date) - 2
    End If
    cba.Value = A: cbm.ListIndex = M:
    cba.ListIndex = A - 1900
    reloadmonth
    Set Me.CallerControl = ctrl
End Sub
Function férié(d As Date) As Boolean
    férié = False
    Dim tbl(1 To 12) As Date, I&
    tbl(1) = DateSerial(Year(d), 1, 1)
    tbl(2) = CDate(((Round(DateSerial(Year(d), 4, (234 - 11 * (Year(d) Mod 19)) Mod 30) / 7, 0) * 7) - 6))
    tbl(3) = tbl(2) + 39 'L'Ascension est une fête chrétienne fixée 40 jours après le dimanche de Pâques. Elle symbolise la montée de Jésus vers Dieu
    tbl(4) = tbl(2) + 50 'Les apôtres ont alors dit : « L'Esprit du Seigneur est sur nous ». Elle clôt le temps pascal de 50 jours. La Pentecôte célèbre à la fois le commencement de l'Église, sa fondation, et l'émergence des premières communautés chrétiennes, au Ier siècle.
    tbl(5) = DateSerial(Application.Max(Year(d), 1919), 5, 1) 'Le 23 avril 1919, le Sénat français ratifie la journée de huit heures et fait du 1er mai suivant, à titre exceptionnel, une journée chômée. Depuis, le 1er mai est resté le jour international des revendications ouvrières, donnant lieu à des défilés de travailleurs
    tbl(6) = DateSerial(Application.Max(Year(d), 1945), 5, 8) 'Victoire des forces alliées sur l'Allemagne nazie et fin de la Seconde Guerre mondiale en Europe, le 8 mai 1945 marque une date importante. Pour le 80e anniversaire de la capitulation nazie
    tbl(7) = DateSerial(Application.Max(Year(d), 1919), 11, 11) '11 novembre - Cérémonie commémorative de l'Armistice du 11 novembre 1918, de la Victoire et de la Paix et d'hommage à tous les Morts pour la France
    tbl(8) = DateSerial(Year(d), 12, 25)
    tbl(9) = tbl(2) + 1
    tbl(10) = DateSerial(Year(d), 7, 14) 'Le 14 juillet, pour sa double valeur symbolique, a finalement été privilégié. La prise de la Bastille en 1789 s'impose dans l'imaginaire collectif comme la victoire du peuple sur l'arbitraire royal, un événement adouci par la fête de 1790 et sa dimension fédératrice autour d'un événement commun
    For I = 1 To UBound(tbl)
        If (d) = (tbl(I)) Then férié = True: Exit For
    Next
End Function

Code:

.BackColor = comboBackColor
.ForeColor = comboFontColor

en fait c'est comme tu veux c'est à toi de choisir. c'est ton code j'ai rien ajouté n'y supprimé.

patricktoulon · Samedi à 16:39

re robert
exact le préfixe en lecture absent ça fonctionne quand même mais il faut laisser le nom "Calendarcolors" et en public

dysorthographie · Samedi à 16:50

patricktoulon à dit:
re robert
exact le préfixe en lecture absent ça fonctionne quand même mais il faut laisser le nom "Calendarcolors" et en public

ha oui pour le coup c'est le nom de l'enumérateur. comme dit plus haut tu peux l'utiliser comme type de variable en paramètre d'une méthode et ta propriété devient intuitive un peut comme les Boolean TRUE/FALSE quand tu écris ta fonction.

patricktoulon · Samedi à 16:55

re
oui c'est un peu comme les blocs type après
trucmachin =nom.property
et ça mange pas de pain en plus

dysorthographie · Samedi à 17:23

Si tu demandes a chatgpt quel était la couleur du cheval blanc d'Henri IV il te répondra blanc alors que le cheval d'Henri IV était de couleur baie et s'appelait Blanc.

Je n'ai pas accès à Cléa mais ça pourrait être rigolo.

Effectuez une recherche sur Excel Downloads...

Microsoft 365 datepicker dynamique intra userform(frame dynamique)(toute version d'excel )

patricktoulon

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

dysorthographie

XLDnaute Accro

ChatGPT a dit :

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

Discussions similaires

Nous accordons de l'importance à votre vie privée

Microsoft 365 datepicker dynamique intra userform(frame dynamique)(toute version d'excel )

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

ChatGPT a dit :​

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Discussions similaires

Nous accordons de l'importance à votre vie privée

ChatGPT a dit :