Ajouter un bouton de fermeture dans le calendrier

C'est, en effet, son avantage.
Après, tu peux effectivement le modifier à ta guise, le code est libre.
Tu pourrais juste à titre d'exemple ajouter un label pour le "mois en cours" qui réagirai au clic pour la fermeture.

J'ai téléchargé les 3 versions.
Dans la version paramétrable partiellement, il ne génère pas message d'erreur;
Par contre tout est affiché en noir.
Dans les 2 autres versions: plantage

Oups...
Ces versions sont en effet assez "anciennes".
Je dispose ce jourd'une version 4 que j'ai oublié de placer en ligne.
Pour toi, je vais donc travailler sur une version 5...

Apparemment tu es le créateur de ce calendrier.
Chapeau
Il fonctionne merveilleusement bien.
Je l'ai intégré dans plusieurs programmes.
Perso, j'aime bien que les userforms soient dépourvus de barre de titre.
Il est vrai que si tu peux intégrer soit un bouton soit un label pour fermer, c'est formidable.
Merci encore

Merci, ça fait plaisir.
Voici la dernière mouture, en exclusivité pour toi...
Version 4.4
La date s'affiche maintenant au survol de la souris sur les boutons 1, 2, 3, 4 etc
Les deux principales nouveautés sont :
1- plus besoin d'userform, il se créé et se détruit tout seul à chaque utilisation
2- tu peux choisir d'afficher ou non la barre de titre. Pour choisir sans afficher, il suffit d'appeler la méthode Value en lui passant le paramètre False. Comme ceci, par exemple :

Dim Cal As New Calendrier
Dim maDate As Date

maDate = Cal.Value(False)

Cf dans l'exemple de code d'appel plus bas.

Dans un module Standard :

Option Explicit

'A placer en entête d'un module standard
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dans un module de classe appelé : Calendrier

Option Explicit
'SOURCES
'http://www.developpez.net/forums/d1513990/logiciels/microsoft-office/excel/macros-vba-excel/reunir-userform-module-classe-seul-module-exportable/
'http://www.commentcamarche.net/faq/41159-vba-excel-toutes-versions-controle-calendrier-transposable
'http://www.commentcamarche.net/faq/43807-vba-creation-d-un-userform-dans-un-module-de-classe
'http://forum.excel-pratique.com/excel/calendrier-portable-t57385.html
'http://blog.developpez.com/philben/p11431/vba-access/calculer-la-date-de-paques
'http://blog.developpez.com/philben/p11458/vba-access/sagit-il-dun-jour-ferie
'http://boisgontierjacques.free.fr/
'http://vb.developpez.com/faqvba/?page=3.6#UFnotitle

'réalisé en mai 2015 par pijaku : http://www.commentcamarche.net/profile/user/pijaku
    'Version 4.3 : 26/05/2015
    'Version 4.4 : 26/02/2015
    
'références à cocher :
   ' Microsoft Forms 2.0 Object Library
   ' Microsoft Visual Basic For Applications Extensibility 5.3.
   
'déclarations, constantes et variables permettant d'inhiber la croix de fermeture et/ou la barre de titre de l'userform
#If VBA7 Then
    Private Declare PtrSafe Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare PtrSafe Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#Else
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
#End If
Private Const SC_CLOSE = 61536
Private Const MF_BYCOMMAND = 0
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const SWP_FRAMECHANGED = &H20
Dim hwnd&, style&
'Variables Public et Private de chaque objet instance de la classe = propriétés des instances de classe
Public Usf As Object
Private Nom$
Public Dicollec As Object
Public Frme As MSForms.Frame
Public Labl As MSForms.Label
Public Txt As MSForms.TextBox
'variables permettant la gestion d'événements (actions sur les contrôles correspondants)
Public WithEvents OpB As MSForms.OptionButton
Public WithEvents Combo As MSForms.ComboBox
Public WithEvents Bouton As MSForms.CommandButton
Public WithEvents MultiPage As MSForms.MultiPage
'constantes approximatives non modifiables dues aux "effets de bord" (userform et/ou frame)
Private Const BORD_B As Byte = 12
Private Const BORD_R As Byte = 4
Private Const BORD_FRAME As Byte = 1
Private Const BORD_AFF As Byte = 18
'Caption des boutons de commande
Private Const CAPTIONS_BTN_CMD$ = "<<,<,>,>>,P,X"
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! NE PAS MODIFIER LES 41 LIGNES CI-DESSOUS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'////DEBUT PARAMETRES
Private Const H_BTN As Byte = 20                            'hauteur des boutons       '0
Private Const W_BTN As Byte = 20                            'largeur des boutons       '0
Private Const W_CMD As Byte = 20                            'largeur des commandes     '0
Private Const H_LAB As Byte = 20                            'hauteur des labels        '0
Private Const MARGE_L As Byte = 1                           'marge gauche              '0
Private Const MARGE_T As Byte = 1                           'marge haut                '0
Private Const FONT_SIZE_LAB As Integer = 12                 'taille police labels      '3
Private Const FONT_SIZE_BTN As Integer = 10                 'taille police boutons     '3
Private Const FONT_SIZE_BTN_CMD As Integer = 8              'taille police commandes   '3
Private Const BC_USF As Long = 12632256                     'fond userform             '1
Private Const BC_F_CMD As Long = 12632256                   'fond commande             '1
Private Const BC_F_JOURS As Long = 12632256                 'fond jours                '1
Private Const BC_CMD As Long = 14737632                     'fond commandes            '2
Private Const FC_CMD As Long = 0                            'couleur police commandes  '4
Private Const F_CMD As String = "Cambria"                    'police commandes          '3
Private Const BC_LAB As Long = 12632256                     'fond labels               '1
Private Const BC_L As Long = 8438015                        'fond boutons lundi        '2
Private Const BC_Ma As Long = 8438015                       'fond boutons mardi        '2
Private Const BC_Me As Long = 8438015                       'fond boutons mercredi     '2
Private Const BC_J As Long = 8438015                        'fond boutons jeudi        '2
Private Const BC_V As Long = 8438015                        'fond boutons vendredi     '2
Private Const BC_S As Long = 192                            'fond boutons samedi       '2
Private Const BC_D As Long = 192                            'fond boutons dimanche     '2
Private Const BC_F As Long = 49152                        'fond boutons fériés       '2
Private Const FC_LAB As Long = 0                            'couleur police labels     '4
Private Const FC_Lu As Long = 0                              'couleur police lundi      '4
Private Const FC_Ma As Long = 8388608                       'couleur police mardi      '4
Private Const FC_Me As Long = 0                             'couleur police mercredi   '4
Private Const FC_J As Long = 0                         'couleur police jeudi      '4
Private Const FC_V As Long = 789516                         'couleur police vendredi   '4
Private Const FC_S As Long = 14211288                       'couleur police samedi     '4
Private Const FC_D As Long = 14211288                       'couleur police dimanche   '4
Private Const FC_F As Long = 0                              'couleur police fériés     '4
Private Const F_LAB As String = "Cambria"                    'police labels             '3
Private Const F_JOURS As String = "Constantia"                  'police jours              '3
Private Const LIST_FONTS As String = "Arial;Calibri;Cambria;Comic Sans MS;Constantia;Courier New;Garamond;Georgia;Lucida Calligraphy;Lucida Console;MS Sans Serif;Monotype Corsiva;Tahoma;Times New Roman;Verdana" 'liste fonts '3
'////FIN PARAMETRES
'Private Const FORM_DATE As String = "dd/mm/yyyy"              'format date               '0
'Private Const LIST_FORMATS As String = "dd/mm/yy;dd/mm/yyyy;mm/dd/yyyy;dd mmmm yyyy;dddd d mmmm yyyy" 'liste formats   '0
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FIN !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Dim ClassCalend As New Calendrier
Dim Affiche As Boolean

Private Sub Class_Initialize()
   Set Dicollec = CreateObject("Scripting.dictionary")
End Sub

Public Function Value(Affich_Barre_Titre As Boolean, Optional Inhib As Boolean, Optional L#, Optional T#)
Dim Liste, Sep$
   'récupère, via la Function Liste_Parametres, les Private Const paramétres du calendrier
   Liste = Liste_Parametres
   Affiche = Affich_Barre_Titre
   'création de l'userform (Caption, Width, Height et Optional Left et Top)
   Call NewUsf(Format(Date, "mmmm yyyy"), 7 * (CInt(Liste(1, 3)) + CInt(Liste(4, 3))) + CInt(Liste(4, 3)) + 5, CInt(Liste(5, 3)) * 2 + CInt(Liste(0, 3)), L, T)
   'Procédure de création des contrôles du Calendrier
   Call Creer_Calendrier(Date, "", Liste, Affich_Barre_Titre)
   'Procédure inhibant la croix de fermeture
   If Affich_Barre_Titre = False Then Call AfficheTitleBarre(Usf.Caption, Affich_Barre_Titre)
   If Inhib = False Then Call Usf_Initialize
   'Attribution du Focus au bouton correspondant à la date du jour
   Usf.Controls("Btn_Jours" & Day(Date)).SetFocus
   'Affichage de l'userform
   Usf.Show
   'le séparateur de date (selon le choix systeme)
   Sep = Application.International(xlDateSeparator)
   'Gestionnaire d'erreur => Si Usf.Tag ne contient rien
   On Error GoTo Fin
   'Attribution à Value de : Usf.Tag (jour) et Usf.Caption (Mois et Année)
   Value = IIf(Usf.Tag = "X", Date, Usf.Tag & Sep & Month(Usf.Caption) & Sep & Right(Usf.Caption, 4))
   'UnLoad l'userform entraine la procédure Class_Terminate
   Unload Usf
   Exit Function
Fin:
   'En cas d'erreur, la valeur de notre calendrier
   Value = CDate(Date)
End Function

Private Sub NewUsf(Cap$, W%, H%, Optional L#, Optional T#)
'procédure de création de l'userform
   Set Usf = ThisWorkbook.VBProject.VBComponents.Add(3)     'création de l'userfom
   Nom = Usf.Name                                           'Stockage du nom de l'userform
   VBA.UserForms.Add (Nom)                                  'ajout de l'userfom à la collection Userforms
   Set Usf = UserForms(UserForms.Count - 1)                 'attribution, à la variable Usf, de l'Userform créé
   With Usf                                                 'paramètres de l'userfom
      .Caption = Cap                                           'Caption (date au format mmmm yyyy)
      .BackColor = BC_USF                                      'BackColor
      .StartUpPosition = 0                                     'StartUpPosition
      If L Then                                             'Si les Optional Left et Top sont demandés
         .Move L, T                                            'positionnement de l'userfom ou souhaité
      Else                                                  'Sinon
         .Move (Application.Width - .Width) / 2, (Application.Height - .Height) / 2 'par défaut : centré dans l'application
      End If
   End With
End Sub

Private Sub NewFrme(Name$, Caption$, Left%, Top%, Width%, Height%, BckCol&)
'Procédure de création d'un Frame (conteneur)
Dim obj As Object
   Set obj = Usf.Controls.Add("forms.frame.1")              'Ajout d'un contrôle de type Frame à l'userform
   If TypeName(obj) = "Nothing" Then Exit Sub               'Traitement d'erreur (si un Frame du même nom existe déjà, par exemple)
   Set ClassCalend.Usf = Usf                              'On attribue, à la propriété Usf de notre instance de classe (Frame), l'Userform **
   Set ClassCalend.Frme = obj                             'remplissage de la propriété Frme de notre instance de classe
   With ClassCalend.Frme                                  'propriétés du Frame
      .Name = Name
      .Caption = Caption
      .BackColor = BckCol
      .Move Left, Top, Width, Height
   End With
   Dicollec.Add Name, ClassCalend                         'Ajout de l'instance de Classe à la collection des objets de l'userform
   Set ClassCalend = Nothing                              'Destruction de l'instance "temporaire" à la Classe
End Sub
'** ceci permet "d'attacher" les contrôles à l'userform.
'Sans cette ligne de code, on ne pourrait pas faire réagir
'les contrôles de l'userform en utilisant, par exemple, Usf.Controls("Frame2")

Public Sub NewBouton(Name$, Caption$, Width%, Height%, Left%, Top%, BckC&, ForeC&, fontSize%, Page%)
'Procédure de création d'un bouton de commande
Dim obj As Object
   If Page > -1 Then                                                    'le paramètre d'appel Page permet de savoir si le bouton
      Set obj = MultiPage(Page).Controls.Add("forms.CommandButton.1")   'est inséré dans un multipage (Page = 0 ou +)
   Else
      Set obj = Frme.Controls.Add("forms.CommandButton.1")              'ou dans un Frame (Page = -1)
   End If
   If obj = True Then Exit Sub                                          'Traitement d'erreur (si un bouton du même nom existe déjà, par exemple)
   Set ClassCalend.Usf = Usf                                          'On attribue, à la propriété Usf de notre instance de classe (Bouton), l'Userform
   Set ClassCalend.Bouton = obj                                       'on attribue notre objet à la propriété Bouton (afin de le faire réagir WithEvents)
   Set ClassCalend.Frme = Frme                                        'Attribution propriété Frme
   With ClassCalend.Bouton                                            'propriétés du Bouton de Commande
      .Name = Name
      .Caption = Caption
      .Move Left, Top, Width, Height
      .BackColor = BckC
      .ForeColor = ForeC
      .Font.Size = fontSize
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub
 
Public Sub NewLabel(Name$, Caption$, Left%, Top%, Width%, Height%, BckC&, ForeC&, fontSize%, Page%)
'Procédure de création d'un Label
Dim obj As Object
   If Page > -1 Then
      Set obj = MultiPage(Page).Controls.Add("forms.Label.1")
   Else
      Set obj = Frme.Controls.Add("forms.Label.1")
   End If
   Set ClassCalend.Usf = Usf
   Set ClassCalend.Labl = obj
   With ClassCalend.Labl
      .Name = Name
      .Caption = Caption
      .Move Left, Top, Width, Height
      .Object.BackColor = BckC
      .Object.ForeColor = ForeC
      .TextAlign = fmTextAlignCenter
      .Font.Size = fontSize
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub

Public Sub NewMultiPage(Name$, Left%, Top%, Width%, Height%, Nb%, ParamArray Onglets())
'Procédure de création d'un Multipage (ParamArray Onglets() = Caption des pages du multipage)
Dim obj As Object, n%, i%
   Set obj = Usf.Controls.Add("forms.MultiPage.1")
   If TypeName(obj) = "Nothing" Then Exit Sub
   Set ClassCalend.Usf = Usf
   Set ClassCalend.MultiPage = obj
   n = ClassCalend.MultiPage.Pages.Count
   n = Nb - n
   For i = 1 To n
      ClassCalend.MultiPage.Pages.Add
   Next
   For i = 0 To UBound(Onglets)
      ClassCalend.MultiPage.Pages(i).Caption = CStr(Onglets(i))
   Next
   With ClassCalend.MultiPage
      .Name = Name
      .Move Left, Top, Width, Height
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub

Public Sub NewOptBout(Name$, Caption$, Left%, Top%, Width%, Height%, cTag$, Page%)
'Procédure de création d'un OptionButton
Dim obj As Object
   Set obj = MultiPage(Page).Controls.Add("forms.OptionButton.1")
   If obj = True Then Exit Sub
   Set ClassCalend.Usf = Usf
   Set ClassCalend.OpB = obj
   With ClassCalend.OpB
      .Name = Name
      .Caption = Caption
      .Tag = cTag
      .Move Left, Top, Width, Height
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub
 
Public Sub NewTextB(Name$, Vis As Boolean, Trans%, Page%, L%, T%, W%, H%, Bloquee As Boolean, Ena As Boolean)
'Procédure de création d'un TextBox
Dim obj As Object
   If Page > -1 Then
      Set obj = MultiPage(Page).Controls.Add("forms.TextBox.1")
   Else
      Set obj = Frme.Controls.Add("forms.TextBox.1")
   End If
   If obj = True Then Exit Sub
   Set ClassCalend.Usf = Usf
   Set ClassCalend.Txt = obj
   With ClassCalend.Txt
      .Name = Name
      .Visible = Vis
      .BackStyle = Trans
      .Move L, T, W, H
      .Locked = Bloquee
      .Enabled = Ena
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub

Public Sub NewCombo(Name$, Liste, Left%, Top%, Width%, Height%, Page%)
'Procédure de création d'une Combobox
Dim obj As Object
   Set obj = MultiPage(Page).Controls.Add("forms.ComboBox.1")
   If obj = True Then Exit Sub
   Set ClassCalend.Usf = Usf
   Set ClassCalend.Combo = obj
   With ClassCalend.Combo
      .Name = Name
      .List = Liste
      .Move Left, Top, Width, Height
   End With
   Dicollec.Add Name, ClassCalend
   Set ClassCalend = Nothing
End Sub
 
Private Sub Usf_Initialize()
'Procédure permettant d'inhiber la croix de fermeture de l'userform
'cette procédure peut être "shuntéee", l'erreur étant traitée dans la Function Value
Dim hSysMenu&, MeHwnd&
    MeHwnd = FindWindowA(vbNullString, Usf.Caption)
    If MeHwnd > 0 Then
        hSysMenu = GetSystemMenu(MeHwnd, False)
        RemoveMenu hSysMenu, SC_CLOSE, MF_BYCOMMAND
    Else
        MsgBox "Handle de " & Usf.Caption & " Introuvable", vbCritical
    End If
End Sub

Private Sub Creer_Calendrier(dte As Date, Simul$, Liste, Affich_Barre_Titre As Boolean)
'Procédure de création des contrôles du calendrier
   'dte sert dans la procédure de création des boutons Jours
   'Simul permet de différencier si l'on est en mode "paramètre" ou "calendrier"
   'Liste = Liste des paramètres complétée à partir des Private Const
Dim i%, W%, H%, Haut%, Cap$, Maxi%, Wtemp%, Ctrl As Control
   W = 7 * (CInt(Liste(1, 3)) + CInt(Liste(4, 3))) + CInt(Liste(4, 3)) + BORD_R        'calcul du Width de l'userform
   Wtemp = 5 * (CInt(Liste(2, 3)) + CInt(Liste(4, 3))) + CInt(Liste(4, 3)) + BORD_R
   If Wtemp > W Then W = Wtemp
   H = CInt(Liste(0, 3)) + BORD_R + CInt(Liste(5, 3)) * 2                              'calcul du Height de l'userform
   NewFrme "Commandes" & Simul, "", 0, 0, W, H, CLng(Liste(10, 3))                     'Frame contenant les boutons de commande "<<", ">", ..., ">>", "P".
   For i = 1 To 6                                                                      'Ajout des 5 boutons de commande
      Cap = CStr(Split(CAPTIONS_BTN_CMD, ",")(i - 1))                                  'Caption
      'NewBouton : Name, Caption, Width, Height, Left, Top, BackColor, ForeColor, fontSize, Page
      Dicollec("Commandes" & Simul).NewBouton "Btn_Cmd" & i, Cap, CInt(Liste(2, 3)), CInt(Liste(0, 3)), (W / 6) * (i - 1) + CInt(Liste(4, 3)), CInt(Liste(5, 3)), CLng(Liste(12, 3)), CInt(Liste(13, 3)), CInt(Liste(8, 3)), -1
   Next
   'Lancement de la procédure de création des boutons "jours"
   Call Creer_Jours(Date, Haut, Simul, Liste)
   With Usf 'Dimensionnement de l'userform en fonction de la taille des contrôles
      If Simul = "" Then
         .Controls("Jours").Height = Haut + CInt(Liste(0, 3)) + BORD_B
         .Width = W + BORD_R
         .Height = H + Haut + CInt(Liste(0, 3)) + BORD_B + BORD_B
         If Affiche = False Then Call AfficheTitleBarre(.Caption, Affiche): .Height = .Height - BORD_AFF: .Move .Left, .Top + BORD_AFF
      Else
         For Each Ctrl In .Controls
            If TypeOf Ctrl Is MSForms.OptionButton Then
               If Ctrl.Top > Maxi Then Maxi = Ctrl.Top
            End If
         Next
         .Controls("Jours" & Simul).Height = Haut + CInt(Liste(0, 3)) + BORD_B
         .Controls("Jours" & Simul).Width = W
         .Width = W + BORD_R + 320
         If .Controls("Jours" & Simul).Height > Maxi Then Maxi = .Controls("Jours" & Simul).Height + .Controls("Jours" & Simul).Top
         .Height = Maxi + 30
         If Affiche = False Then Call AfficheTitleBarre(.Caption, Affiche): .Height = .Height - BORD_AFF: .Move .Left, .Top + BORD_AFF
      End If
   End With
End Sub

Private Sub Creer_Jours(dte As Date, Haut%, Simul$, Liste)
'Procédure de création des boutons "Jours"
Dim i%, NbJ As Byte, d As Date, G%, BckC&, ForeC&, Cap$
   'création du Frame conteneur
   NewFrme "Jours" & Simul, "", 0, CInt((CInt(Liste(0, 3)) + BORD_R + CInt(Liste(5, 3)) * 2) - BORD_FRAME), CInt(7 * (CInt(Liste(1, 3)) + CInt(Liste(4, 3))) + CInt(Liste(4, 3)) + BORD_R), CInt(Liste(0, 3)), CLng(Liste(11, 3))
   For i = 1 To 7 'création des 7 Labels "L", "M", "M" etc
      Cap = UCase(Left(Format(DateSerial(2014, 9, i), "dddd"), 1)) 'Caption
      'NewLabel : Name, Caption, Left, Top, Width, Height, BackColor, ForeColor, fontSize, Page
      Dicollec("Jours" & Simul).NewLabel "Lab" & i, Cap, CInt(CInt(Liste(4, 3)) + (CInt(Liste(1, 3)) + CInt(Liste(4, 3))) * (i - 1)), CInt(Liste(5, 3)), CInt(Liste(1, 3)), CInt(Liste(3, 3)), CLng(Liste(15, 3)), CLng(Liste(24, 3)), CInt(Liste(6, 3)), -1
   Next i
   'Nombre de jours du mois
   NbJ = Day(DateSerial(Year(dte), Month(dte) + 1, 1) - 1)
   'Haut = Top du premier bouton
   Haut = CInt(Liste(5, 3)) + CInt(Liste(3, 3)) + CInt(Liste(5, 3))
   For d = DateSerial(Year(dte), Month(dte), 1) To DateSerial(Year(dte), Month(dte), NbJ)
      Select Case Weekday(d, vbMonday) 'Calculs : G = Left, BckC = BackColor, ForeC = ForeColor et Haut = top du bouton
         Case 1: G = CInt(Liste(4, 3)): BckC = CLng(Liste(16, 3)): ForeC = CLng(Liste(25, 3)): If Day(d) <> 1 Then Haut = Haut + CLng(Liste(0, 3)) + CLng(Liste(5, 3))
         Case 2: G = CInt(Liste(4, 3)) * 2 + CInt(Liste(1, 3)): BckC = CLng(Liste(17, 3)): ForeC = CLng(Liste(26, 3))
         Case 3: G = CInt(Liste(4, 3)) + CInt((Liste(4, 3)) + CInt(Liste(1, 3))) * 2: BckC = CLng(Liste(18, 3)): ForeC = CLng(Liste(27, 3))
         Case 4: G = CInt(Liste(4, 3)) + (CInt(Liste(4, 3)) + CInt(Liste(1, 3))) * 3: BckC = CLng(Liste(19, 3)): ForeC = CLng(Liste(28, 3))
         Case 5: G = CInt(Liste(4, 3)) + (CInt(Liste(4, 3)) + CInt(Liste(1, 3))) * 4: BckC = CLng(Liste(20, 3)): ForeC = CLng(Liste(29, 3))
         Case 6: G = CInt(Liste(4, 3)) + (CInt(Liste(4, 3)) + CInt(Liste(1, 3))) * 5: BckC = CLng(Liste(21, 3)): ForeC = CLng(Liste(30, 3))
         Case 7: G = CInt(Liste(4, 3)) + (CInt(Liste(4, 3)) + CInt(Liste(1, 3))) * 6: BckC = CLng(Liste(22, 3)): ForeC = CLng(Liste(31, 3))
      End Select
      'Si férié
      If EstJourFerie(Year(d), d) Or Paques(Year(d)) = d Then BckC = CLng(Liste(23, 3)): ForeC = CLng(Liste(32, 3))
      'NewBouton : Name, Caption, Width, Height, Left, Top, BackColor, ForeColor, fontSize, Page
      Dicollec("Jours" & Simul).NewBouton "Btn_Jours" & Day(d), CStr(Day(d)), CInt(Liste(1, 3)), CInt(Liste(0, 3)), G, Haut, BckC, ForeC, CInt(Liste(7, 3)), -1
   Next d
End Sub

Private Sub Creer_Parametres(dte As Date, Affich_Barre_Titre As Boolean, Optional Page$)
'Procédure de création des contrôles en Mode "paramètres"
Dim ListParam, i%, Cible$, cNom$, cCap$, cPage%, cVal$, x(4), Maxi%, ListF
   'Création du Calendrier en Mode "Simul" afin d'inhiber la procédure Bouton_Click
   ListParam = Liste_Parametres
   Call Creer_Calendrier(dte, "S", ListParam, Affich_Barre_Titre)
   'NewTextB : Name, Visible, Transparence, Page, Left, Top, Width, Height, Locked, Enabled
   Dicollec("JoursS").NewTextB "Cadre", False, 0, -1, 1, 1, 1, 1, False, True 'textbox permettant de repérer les boutons dans le calendrier
   'NewMultiPage : Name, Left, Top, Width, Height, NbPages, Onglets()
   NewMultiPage "Params", Usf.Controls("JoursS").Width, 0, 320, Usf.Height, 5, "General", "Couleur conteneurs", "Couleur Boutons", "Font Style", "Font Color"
   With Dicollec("Params")
      For i = 0 To 34
         'NewOptBout : Name, Caption, Left, Top, Width, Height, Tag, Page
         .NewOptBout CStr(ListParam(i, 0)), CStr(ListParam(i, 1)), 0, MARGE_T + 10 + x(CInt(ListParam(i, 2))), 160, 15, Replace(CStr(ListParam(i, 3)), """", ""), CInt(ListParam(i, 2))
         x(ListParam(i, 2)) = x(ListParam(i, 2)) + 15 'X() = propriété Top des OptionButton selon la page
      Next
      '.NewLabel "LFormDate", "Format :", 0, X(0) + 15, 100, 14, BC_USF, FC_LAB, 10, 0
      .NewLabel "LFormFonts", "Polices :", 0, x(3) + 15, 100, 14, BC_USF, FC_LAB, 10, 3
      'ListF = Split(LIST_FORMATS, ";")
      'NewCombo : Name, Liste, Left, Top, Width, Height, Page
      '.NewCombo "ComboFormat", ListF, 0, X(0) + 30, 100, 20, 0
      ListF = Split(LIST_FONTS, ";")
      Call tri(ListF, LBound(ListF), UBound(ListF))
      .NewCombo "ComboFonts", ListF, 0, x(3) + 30, 100, 20, 3
      For i = 0 To 3
         If x(i) > x(i + 1) Then Maxi = x(i) Else Maxi = x(i + 1)
      Next i
      For i = 0 To 4
         'une croix de fermeture sur chaque Page
         .NewBouton "Croix" & i, "X", 20, 20, 290, 0, BC_CMD, FC_CMD, FONT_SIZE_BTN_CMD, i
         If i <> 1 And i <> 2 And i <> 4 Then
            'pour les pages 0 & 3 bouton "Valider"
            .NewBouton "VALID" & i, "Valider", 60, 20, 185, 45, BC_CMD, FC_CMD, FONT_SIZE_BTN_CMD, i
         Else
            'pages 1, 2 & 4 Boutons "OK"
            .NewBouton "VALID" & i, "OK", 20, 20, 250, 20, BC_CMD, FC_CMD, FONT_SIZE_BTN_CMD, i
         End If
         'pour toutes les pages Labels et TextBox "ancienne valeur" "nouvelle valeur"
         'pour permettre la saisie manuelle de valeurs
         .NewLabel "Lancien" & i, "Ancien :", 120, 5, 60, 14, BC_USF, FC_LAB, 10, i
         .NewTextB "Ancien" & i, True, 1, i, 120, 20, 60, 20, True, False
         .NewLabel "Lnouveau" & i, "Nouveau :", 185, 5, 60, 14, BC_USF, FC_LAB, 10, i
         .NewTextB "Nouveau" & i, True, 1, i, 185, 20, 60, 20, False, True
         .NewLabel "LCache" & i, "", 0, 0, 0, 0, BC_USF, FC_LAB, 10, i
         'pour les pages 1, 2 & 4 création des boutons de couleurs
         If i = 1 Or i = 2 Or i = 4 Then Call CreerBoutonsCouleurs(i)
      Next i
   End With
   With Usf 'Dimensions Userform
      .Controls("Params").Height = Maxi + 60
      If .Height < .Controls("Params").Height Then
         .Height = .Controls("Params").Height
      End If
   End With
   'Ouverture du Multipage soit sur la Page précédemment choisie, soit, par défaut, sur la page 0
   If Page <> "" Then Usf.Controls("Params").Value = CInt(Page)
End Sub

Private Sub CreerBoutonsCouleurs(P%)
'procédure de création des boutons de commande "couleurs"
Dim i%, Coul, List$, x%, y%, Cpt%
   List = "16777215;12632319;12640511;12648447;12648384;16777152;16761024;16761087;14737632;8421631;8438015;8454143;8454016;16777088;16744576;16744703;12632256;255;33023;65535;65280;16776960;16711680;16711935;8421504;192;16576;49344;49152;12632064;12582912;12583104;4210752;128;16512;32896;32768;8421376;8388608;8388736;0;64;4210816;16448;16384;4210688;4194304;4194368"
   Coul = Split(List, ";")
   x = 120  'Left
   y = 30   'top
   For i = 0 To UBound(Coul)
      'Une rangé = 8 boutons
      If i Mod 8 = 0 Then x = 120: y = y + 15: Cpt = 0
      'NewBouton : Name, Caption, Width, Height, Left, Top, BackColor, ForeColor, fontSize, Page
      Dicollec("Params").NewBouton "Btn_Coul" & P & i, "", 15, 15, x + (15 * Cpt), y, CLng(Coul(i)), 0, 10, P
      Cpt = Cpt + 1
   Next
End Sub

Private Sub Bouton_Click()
'Procédure événementielle lors d'un clic sur un bouton
Dim maDate As Date, P%, Anc$, Nouv$, Liste, Quoi$, Ctrl As Control
   Select Case True
      Case Usf.Caption = "Paramètres"  'Mode paramètre
         P = Usf.Controls("Params").SelectedItem.Index         'P = page du multipage "en cours"
         For Each Ctrl In Usf.Controls("Params")(P).Controls   'quel optionButton est sélectionné
            If TypeOf Ctrl Is MSForms.OptionButton Then
               If Ctrl.Value = True Then
                  Quoi = Ctrl.Name
               End If
            End If
         Next Ctrl
         Select Case Bouton.Caption          'selon le Caption du bouton cliqué
            Case "X"                                           'Cas de la croix
               SupprTousControles "Parametres"                 'on quitte le Mode paramètres
               Usf.Caption = Format(Date, "mmmm yyyy")         'on recrée le calendrier
               Liste = Liste_Parametres
               Creer_Calendrier Date, "", Liste, Affiche
            Case "Valider", "OK"                               'Cas Valider ou Ok
               'If Quoi = "" Then                               'cas particulier du choix de format de date (aucun OptionButton n'est à True)
               '   If P = 0 And Usf.Controls("ComboFormat") <> "" Then   'page = 0 et un choix est fait dans la liste des formats de date
               '      Quoi = "FORM_DATE"
               '   Else
               '      GoTo Fin
               '   End If
               'End If
               Anc = Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value      'ancienne valeur
               Nouv = Usf.Controls("Nouveau" & Usf.Controls("Params").SelectedItem.Index).Value    'nouvelle valeur
               If Nouv = "" Then Exit Sub    'évite l'erreur si aucune nouvelle valeur n'est saisie (soit manuellement soit par clic sur un bouton couleur)
               Nouv = Replace(Nouv, """", "")      'évite les erreurs dues aux guillemets (String, pas String...)
               Call Verif_Valeur(Nouv, Quoi, Anc)  'procédure de vérification des valeurs saisies
               SupprTousControles "Parametres"     'On relance le mode paramètre
               Usf.Caption = "Paramètres"          'pour actualisation des paramètres du Calendrier
               Creer_Parametres Date, Affiche, CStr(P)
            Case ""                                            'Cas des boutons de couleurs
               If Quoi = "" Then GoTo Fin                      'si aucun optionButton sélectionné
               If Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value = "" Then Exit Sub  'si aucune ancienne valeur
               Usf.Controls("Nouveau" & Usf.Controls("Params").SelectedItem.Index).Value = Bouton.BackColor    'Complete le textbox "nouvelle valeur"
               Anc = Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value   'ancienne valeur
               Nouv = Usf.Controls("Nouveau" & Usf.Controls("Params").SelectedItem.Index).Value 'nouvelle valeur
               Call Simulation(P, Quoi)                     'simulation et modification des Private Const
               Call ModifieConst(P, Quoi, Anc, Nouv)
               SupprTousControles "Parametres"              'actualisation des paramètres du Calendrier
               Usf.Caption = "Paramètres"
               Creer_Parametres Date, Affiche, CStr(P)
         End Select
      Case Else            'Mode Calendrier
         Select Case Bouton.Caption
            'cas des boutons de commande
            Case "<<": ChangeCaptionUsf 0, -1   'procédure de changement du Caption de l'userform
            Case "<": ChangeCaptionUsf -1, 0    '(Caption : mois en cours au format mmmm yyyy)
            Case ">": ChangeCaptionUsf 1, 0
            Case ">>": ChangeCaptionUsf 0, 1
            Case "P"
               maDate = CDate("1 " & Usf.Caption)  'lancement du mode "paramètres"
               SupprTousControles "Calendrier"
               Usf.Caption = "Paramètres"
               Creer_Parametres maDate, Affiche
            Case "X"
               Usf.Tag = "X"
               Usf.Hide
            Case Else
            'cas des boutons jours
               Usf.Tag = Right("0" & Bouton.Caption, 2) 'on stocke le jour choisi dans le Tag de l'userform
               Usf.Hide                                 'Hide rend la main à la fonction Value
         End Select
   End Select
   Exit Sub
Fin:
MsgBox "Vous devez préalablement sélectionner un paramètre à modifier", vbInformation
End Sub

Private Sub Bouton_MouseMove(ByVal Button%, ByVal Shift%, ByVal x As Single, ByVal y As Single)
'Procédure événementielle lors du survol des boutons
Dim maDate As Date
    If Bouton.Caption = "X" Then Bouton.ControlTipText = "Fermeture"
    If Usf.Caption = "Paramètres" Then  'en mode paramètres, affichage d'infos bulles
        If Bouton.Caption = "OK" Then Bouton.ControlTipText = "Validation des saisies manuelles"
        If Bouton.Caption = "Valider" Then Bouton.ControlTipText = "Validation"
        Exit Sub
    End If
    'en mode paramètres on ne fait plus rien sur les boutons jours
    If Frme.Name <> "Jours" Then Exit Sub
    If Bouton.Caption = "<<" Or Bouton.Caption = "<" Or Bouton.Caption = ">" Or Bouton.Caption = ">>" Or Bouton.Caption = "P" Or Bouton.Caption = "" Then Exit Sub
    'sinon, au survol des boutons jours, en mode calendrier, on affiche une info bulle jour = férié
    maDate = CDate(Bouton.Caption & "/" & Usf.Caption)
    If EstJourFerie(Year(maDate), maDate) Or Paques(Year(maDate)) = maDate Then
        Bouton.ControlTipText = Format(maDate, "dd mmmm yyyy") & " : " & QuelFerie(maDate)
    Else
        Bouton.ControlTipText = Format(maDate, "dd mmmm yyyy")
    End If
End Sub

Private Sub OpB_Click()
'Procédure événementielle lors d'un clic sur un OptionButton
Dim Diff%, ListParam
   ListParam = Liste_Parametres
   If OpB = True Then
      Diff = CInt(ListParam(5, 3)) * 2 + CInt(ListParam(3, 3))
      'dans certains cas, va afficher le textbox permettant de repérer les boutons pour lesquels on va changer les paramètres
      Select Case OpB.Caption
         Case "fond labels", "couleur police labels": MoveCadre Usf.Controls("JoursS").Width, CInt(ListParam(3, 3)), 0, 0, True
         Case "fond boutons lundi", "couleur police lundi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, 0, Diff, True
         Case "fond boutons mardi", "couleur police mardi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Diff, True
         Case "fond boutons mercredi", "couleur police mercredi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, (ListParam(1, 3) + CInt(ListParam(4, 3))) * 2, Diff, True
         Case "fond boutons jeudi", "couleur police jeudi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, (CInt(ListParam(1, 3)) + CInt(ListParam(4, 3))) * 3, Diff, True
         Case "fond boutons vendredi", "couleur police vendredi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, (CInt(ListParam(1, 3)) + CInt(ListParam(4, 3))) * 4, Diff, True
         Case "fond boutons samedi", "couleur police samedi": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, (CInt(ListParam(1, 3)) + CInt(ListParam(4, 3))) * 5, Diff, True
         Case "fond boutons dimanche", "couleur police dimanche": MoveCadre CInt(ListParam(1, 3)) + CInt(ListParam(4, 3)), Usf.Controls("JoursS").Height - Diff - 10, (CInt(ListParam(1, 3)) + CInt(ListParam(4, 3))) * 6, Diff, True
         Case Else: MoveCadre 0, 0, 0, 0, False
      End Select
      Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value = OpB.Tag
   End If
End Sub

Private Sub Combo_Click()
'Procédure événementielle lors d'un clic sur une ComboBox
Dim i%, Cible$, Fin$, Liste, Ctrl As Control
   If Combo.Value = "" Then Exit Sub
   Liste = Liste_Parametres
   Select Case Combo.Name
      Case "ComboFormat"
         'si on change le format de date, aucun OptionButton ne doit être à true
         For Each Ctrl In Usf.Controls("Params")(Usf.Controls("Params").SelectedItem.Index).Controls
            If TypeOf Ctrl Is MSForms.OptionButton Then
               If Ctrl.Value = True Then Ctrl.Value = False
            End If
         Next Ctrl
         'ancienne valeur
         Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value = Replace(Liste(35, 3), """", "")
         'nouvelle valeur
         Usf.Controls("Nouveau" & Usf.Controls("Params").SelectedItem.Index).Value = Combo.Value
      Case "ComboFonts"
         If Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value = "" Then
            MsgBox "Vous devez préalablement choisir une option à modifier", vbInformation
            Exit Sub
         End If
         If IsNumeric(Usf.Controls("Ancien" & Usf.Controls("Params").SelectedItem.Index).Value) Then
            MsgBox "Ce type de paramètre n'admet pas cette valeur. " & vbCrLf & _
                     "Merci de saisir une valeur numérique dans le champ de saisie NOUVEAU.", vbInformation
            Combo.Value = ""
            Exit Sub
         End If
         Usf.Controls("Nouveau" & Usf.Controls("Params").SelectedItem.Index).Value = Combo.Value
         Combo.Value = ""
   End Select
   Exit Sub
Fin:
   MsgBox "La constante de format de date FORM_DATE a été effacée!", vbCritical
End Sub

Private Sub MultiPage_Change()
'procédure événementielle lors du changement de page
   MoveCadre 0, 0, 0, 0, False   'rend invisible, éventuellement le cadre de repérage
End Sub

Private Sub Class_Terminate()
'Destructeur de la Classe
Dim i%, VBComp As VBComponent
    Set Dicollec = Nothing    'suppression de toutes les instances de la classe
    If Nom <> "" Then
        'Suppression de l'userform
        Set VBComp = ThisWorkbook.VBProject.VBComponents(Nom)
        ThisWorkbook.VBProject.VBComponents.Remove VBComp
    End If
End Sub

Private Sub ChangeCaptionUsf(m%, y%)
'procédure de changement du Caption de l'userform
Dim Cap$, maDate As Date, Haut%, Liste
   Cap = Usf.Caption
   maDate = CDate(1 & " " & Cap)
   maDate = DateSerial(Year(maDate) + y, Month(maDate) + m, 1)
   Usf.Caption = Format(maDate, "mmmm yyyy")
   Call AfficheTitleBarre(Usf.Caption, Affiche)
   Call RemoveBoutonsJours 'suppression des boutons "jours" du mois précédent
   Liste = Liste_Parametres
   Call Creer_Jours(maDate, Haut, "", Liste) 'création des boutons "jours" du mois choisi
   Usf.Controls("Jours").Height = Haut + CInt(Liste(0, 3)) + BORD_B  'ajustement de la taille de l'userform (mois à 4, 5 ou 6 "semaines")
   Usf.Height = Usf.Controls("Jours").Height + Usf.Controls("Jours").Top + BORD_B
   If Affiche = False Then Usf.Height = Usf.Height - BORD_AFF: Usf.Move Usf.Left, Usf.Top + BORD_AFF
End Sub

Private Sub RemoveBoutonsJours()
'supprime tous les CommandButton "Jours"
   Usf.Controls.Remove "Jours"   'suppression du Frame
   Set Dicollec("Jours") = Nothing  'suppression de toutes les instances de Classe contenues dans le Frame
   Dicollec.Remove "Jours"       'suppression de l'instance de classe "Frame jours"
End Sub

Private Sub SupprTousControles(Duquel$)
'suppression des contrôles et/ou instances de classe
   Select Case Duquel
      Case "Parametres"
         Usf.Controls.Remove "JoursS"
         Set Dicollec("JoursS") = Nothing
         Dicollec.Remove "JoursS"
         Usf.Controls.Remove "CommandesS"
         Set Dicollec("CommandesS") = Nothing
         Dicollec.Remove "CommandesS"
         Usf.Controls.Remove "Params"
         Set Dicollec("Params") = Nothing
         Dicollec.Remove "Params"
      Case "Calendrier"
         Usf.Controls.Remove "Jours"
         Set Dicollec("Jours") = Nothing
         Dicollec.Remove "Jours"
         Usf.Controls.Remove "Commandes"
         Set Dicollec("Commandes") = Nothing
         Dicollec.Remove "Commandes"
      Case "Simulation"
         Usf.Controls.Remove "JoursS"
         Set Dicollec("JoursS") = Nothing
         Dicollec.Remove "JoursS"
         Usf.Controls.Remove "CommandesS"
         Set Dicollec("CommandesS") = Nothing
         Dicollec.Remove "CommandesS"
   End Select
End Sub

Private Sub MoveCadre(Width%, Height%, Left%, Top%, Vis As Boolean)
'procédure qui bouge le cadre de repérage
   Usf.Controls("Cadre").Move Left, Top, Width, Height
   Usf.Controls("Cadre").Visible = Vis
End Sub

Private Function Liste_Parametres() As Variant()
'Liste tous les paramètres contenus dans les Private Const
Dim i%, Cible$, Cpt%, ListParam(37, 3)
   'Source : http://excel.developpez.com/faq/index.php?page=VBA#RemplacerMotVBE
   With ActiveWorkbook.VBProject.VBComponents("Calendrier").CodeModule
      Do
         i = i + 1
         Cible = .Lines(i, 1)
      Loop While Cible <> "'////DEBUT PARAMETRES"
      i = i + 1
      Do
         Cible = .Lines(i, 1)
         If Cible = "'////FIN PARAMETRES" Then Exit Do
         ListParam(Cpt, 0) = Mid(Cible, InStr(Cible, "Const") + 6, InStr(Cible, "As") - (InStr(Cible, "Const") + 7)) 'nom de la constante
         ListParam(Cpt, 1) = Trim(Split(Cible, "'")(1))                                                              'Caption OpB
         ListParam(Cpt, 2) = CInt(Split(Cible, "'")(2))                                                              'Page du multipage
         ListParam(Cpt, 3) = Trim(Split(Split(Cible, "'")(0), "=")(1))                                               'valeur de la constante
         Cpt = Cpt + 1
         i = i + 1
      Loop
   End With
   Liste_Parametres = ListParam
End Function

Private Sub Simulation(P%, Quoi$)
'remplit une variable tableau en modifiant le paramètre choisi
Dim i%, ListParam, maVal
   ListParam = Liste_Parametres
   maVal = Usf.Controls("Nouveau" & P).Value
   For i = 0 To 37
      If CStr(Quoi) = CStr(ListParam(i, 0)) Then
         ListParam(i, 3) = maVal
         Exit For
      End If
   Next i
End Sub

Private Sub ModifieConst(P%, Quoi$, Ancien$, Nouveau$)
'Modification des Private Const
Dim i%, Cible$
   With ActiveWorkbook.VBProject.VBComponents("Calendrier").CodeModule
      Do
         i = i + 1
         Cible = .Lines(i, 1)
      Loop While Cible <> "'////DEBUT PARAMETRES"
      i = i + 1
      Do
         Cible = .Lines(i, 1)
         If Cible = "'////FIN PARAMETRES" Then Exit Do
         If Cible Like "Private Const " & Quoi & "*" Then
            Cible = Replace(Cible, Ancien, Nouveau)
            .ReplaceLine i, Cible
         End If
         i = i + 1
      Loop
   End With
End Sub

Private Sub Verif_Valeur(maVal$, Quoi$, Anc$)
'procédure de vérification des valeurs saisies
Dim ListParam, ListF, i%, Trouve As Boolean, Nouv$, Modif As Boolean
   Select Case Quoi
      Case "": Exit Sub
      Case "H_BTN", "W_BTN", "W_CMD", "H_LAB"                           '-taille des boutons et labels
         If test_1(maVal, Anc) Then test_2 maVal, Anc, 10, 60
      Case "MARGE_L", "MARGE_T"                                         '-marges
         If test_1(maVal, Anc) Then test_2 maVal, Anc, 0, 10
      Case "FONT_SIZE_LAB", "FONT_SIZE_BTN", "FONT_SIZE_BTN_CMD"        '-taille police
         If test_1(maVal, Anc) Then test_2 maVal, Anc, 6, 20
      Case "F_LAB", "F_JOURS", "F_CMD"                                  '-polices
         If Police_Exist(maVal) Then
            ListParam = Liste_Parametres
            ListF = Split(LIST_FONTS, ";")
            Trouve = False
            For i = 0 To UBound(ListF)
               If CStr(ListF(i)) = maVal Then Trouve = True: Exit For
            Next i
            If Trouve = False Then
               ReDim Preserve ListF(UBound(ListF) + 1)
               ListF(UBound(ListF)) = maVal
               Call tri(ListF, LBound(ListF), UBound(ListF))
               Nouv = Join(ListF, ";")
               ModifieConst Usf.Controls("Params").SelectedItem.Index, "LIST_FONTS", CStr(ListParam(37, 3)), """" & Nouv & """"
               ModifieConst Usf.Controls("Params").SelectedItem.Index, Quoi, Anc, maVal
               Modif = True
            End If
         Else
            MsgBox "Police inconnue dans votre système d'exploitation", vbInformation
            maVal = Anc
            Modif = True
         End If
      'Case "FORM_DATE"                                                  '-format de dates
      '   ListF = Split(LIST_FORMATS, ";")
      '   Modif = True
      '   For i = 0 To UBound(ListF)
      '      If CStr(ListF(i)) = maVal Then
      '         MsgBox "Cette modification ne sera prise en compte qu'à partir de la prochaine utilisation", vbInformation
      '         Modif = False
      '         Exit For
      '      End If
      '   Next i
      Case Else                                                         '-couleurs back et forecolor
         If test_1(maVal, Anc) Then test_2 maVal, Anc, 0, 2147483647
   End Select
   If Modif = False Then
      Call Simulation(Usf.Controls("Params").SelectedItem.Index, Quoi)
      Call ModifieConst(Usf.Controls("Params").SelectedItem.Index, Quoi, Anc, maVal)
   End If
End Sub

Private Function test_1(maVal$, Anc$) As Boolean
'test si valeur numérique
   If Not IsNumeric(maVal) Then
      MsgBox "Cette valeur doit être numérique"
      maVal = Anc
      Exit Function
   End If
   test_1 = True
End Function

Private Sub test_2(maVal$, Anc$, BorneInf&, BorneSup&)
'test si valeur entre bornes
   If Val(maVal) < BorneInf Or Val(maVal) > BorneSup Then
      MsgBox "Cette valeur doit être comprise entre " & BorneInf & " et " & BorneSup
      maVal = Anc
   End If
End Sub

Private Function Police_Exist(myNom$) As Boolean
'si police installée dans le système
    On Error Resume Next
    With New StdFont
        .Name = myNom
        Police_Exist = (StrComp(myNom, .Name, vbTextCompare) = 0)
        myNom = .Name
    End With
End Function

Private Function EstJourFerie(ByVal Annee%, ByVal laDate As Date, Optional ByVal EstPentecoteFerie As Boolean = True) As Boolean
'Philben - v1.0 - 2012 - Free to use
Static dPa As Date, dAs As Date, dPe As Date, bPe As Boolean
Dim a%, m%, j%
   a = Year(laDate): m = Month(laDate): j = Day(laDate)
   Select Case m * 100 + j
      Case 101, 501, 508, 714, 815, 1101, 1111, 1225
         EstJourFerie = True
      Case 323 To 614   '323: Date mini Lundi de Pâques - 614 : Date maxi Lundi de Pentecôte
         If a <> Annee Or EstPentecoteFerie <> bPe Then
            Annee = a: dPa = Paques(a) + 1: dAs = dPa + 38
            bPe = EstPentecoteFerie: If bPe Then dPe = dPa + 49 Else dPe = #1/1/100#
         End If
      Select Case DateSerial(a, m, j): Case dPa, dAs, dPe: EstJourFerie = True: End Select
   End Select
End Function
Private Function Paques(ByVal An%) As Date
'Philben - v1.0 - Free to use
Dim a%, b%, c%, d%, e%, F%
   If An < 10000 Then    'Limite supérieure des dates sous Access (31 décembre 9999)
      Select Case An
         Case 1900 To 2099    'Algorithme de Carter
            a = (204 - 11 * (An Mod 19)) Mod 30 + 22
            Paques = DateSerial(An, 3, a + 6 + (a > 49) - (An + An \ 4 + a + (a > 49)) Mod 7)
         Case Is > 1582    'Proposé en 1876 dans la revue Nature (dérivé de l'algorithme de Delambre)
            a = An Mod 19: b = An \ 100: c = An Mod 100
            d = (19 * a + b - b \ 4 - (b - (b + 8) \ 25 + 1) \ 3 + 15) Mod 30
            e = (32 + 2 * (b Mod 4) + 2 * (c \ 4) - d - c Mod 4) Mod 7
            F = d + e - 7 * ((a + 11 * d + 22 * e) \ 451) + 114
            Paques = DateSerial(An, F \ 31, F Mod 31 + 1)
         Case Is > 324    'Algorithme de Oudin pour les dates juliennes < 1583 décrit par Claus Tondering
            a = (19 * (An Mod 19) + 15) Mod 30
            Paques = DateSerial(An, 3, 28 + a - (An + An \ 4 + a) Mod 7)
      End Select
   End If
End Function
Private Function QuelFerie(Jour As Date) As String
Dim maDate As Date, a%, m%, j%
   maDate = Paques(Year(Jour))
   Select Case Jour
      Case maDate: QuelFerie = "Dimanche de Pâques": Exit Function
      Case CDate(maDate + 1): QuelFerie = "Lundi de Pâques": Exit Function
      Case CDate(maDate + 50): QuelFerie = "Lundi de Pentecôte": Exit Function
      Case CDate(maDate + 39): QuelFerie = "Jeudi de l'ascension": Exit Function
   End Select
   a = Year(Jour): m = Month(Jour): j = Day(Jour)
   Select Case m * 100 + j
      Case 101: QuelFerie = "Nouvel An": Exit Function
      Case 501: QuelFerie = "Fête du travail": Exit Function
      Case 508: QuelFerie = "Armistice 39-45": Exit Function
      Case 714: QuelFerie = "Fête Nationale": Exit Function
      Case 815: QuelFerie = "Assomption": Exit Function
      Case 1101: QuelFerie = "Toussaint": Exit Function
      Case 1111: QuelFerie = "Armistice 14-18": Exit Function
      Case 1225: QuelFerie = "Noël": Exit Function
   End Select
End Function
Sub tri(a, gauc, droi) ' Quick sort
'http://boisgontierjacques.free.fr/
Dim ref, G, d, Temp
  ref = a((gauc + droi) \ 2)
  G = gauc: d = droi
  Do
    Do While a(G) < ref: G = G + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If G <= d Then
       Temp = a(G): a(G) = a(d): a(d) = Temp
       G = G + 1: d = d - 1
    End If
  Loop While G <= d
  If G < droi Then Call tri(a, G, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Sub AfficheTitleBarre(stCaption As String, pbVisible As Boolean)
Dim vrWin As RECT
Dim style As Long
Dim lHwnd As Long
'- Recherche du handle de la fenêtre par son Caption
    lHwnd = FindWindowA(vbNullString, stCaption)
    If lHwnd = 0 Then
        MsgBox "Handle de " & stCaption & " Introuvable", vbCritical
        Exit Sub
    End If
    
    GetWindowRect lHwnd, vrWin
    style = GetWindowLong(lHwnd, GWL_STYLE)
    If pbVisible Then
        SetWindowLong lHwnd, GWL_STYLE, style Or WS_CAPTION
    Else
        SetWindowLong lHwnd, GWL_STYLE, style And Not WS_CAPTION
    End If
    SetWindowPos lHwnd, 0, vrWin.Left, vrWin.Top, vrWin.Right - vrWin.Left, _
            vrWin.Bottom - vrWin.Top, SWP_FRAMECHANGED
End Sub

Et c'est tout...

Le code pour appeler le calendrier est :

Dim Cal As New Calendrier
Dim maDate As Date

maDate = Cal.Value(False)
MsgBox maDate
'pour afficher la date dans une cellule :
'Range("A1") = maDate
'pour placer la date dans un TextBox1 :
'TextBox1 = maDate
Set Cal = Nothing

IMPORTANT :

'Les 4 paramètres de .Value sont :

    'Affich_Barre_Titre As Boolean, Optional Inhib As Boolean, Optional L#, Optional T#
    
    'Affich_Barre_Titre As Boolean ==> Obligatoire
        'Valeurs True ou False
        'Affiche ou non la barre de titre de l'UserForm calendrier
        'Exemple : maDate = Cal.Value(True)
    'Optional Inhib As Boolean ==> Optionnel
        'Valeurs True ou False
        'Inhibe (empêche le clic) ou déshinibe (permet le clic) sur la croix de fermeture de l'UserForm
        'Exemple : maDate = Cal.Value(True, True)
    'Optional L# ==> Optionnel
        'Valeur = Double (Numérique)
        'Valeur du Left de l'UserForm par rapport à son parent
    'Optional T# ==> Optionnel
        'Valeur = Double (Numérique)
        'Valeur du Top de l'UserForm par rapport à son parent
        'Exemple : maDate = Cal.Value(True, True, 350, 200)