VBA - Calendrier sur la base d'un UserForm [Supprimé]

'-----------
'Test simple
'-----------
Sub TestSimple()
    Call PositionSousBouton(ActiveSheet.Shapes("Bouton Simple"), Left, Top)
 
    Call UserForm_Calendrier.Display(Texte:="Saisir une date d'un lundi", _
                                     Left:=Left, Top:=Top, _
                                     FonctionSurChoixUtilisateur:="FonctionLundi", _
                                     GarderOuvert:=True)
End Sub

'-----------------------------
'Fonction utilisateur sur date
'-----------------------------
Sub FonctionLundi(DateChoisie As Date)
    If DateChoisie = 0 Then
        MsgBox "Saisir une date non nulle !"
    ElseIf Weekday(DateChoisie, 2) <> 1 Then
        MsgBox "La date saisie ne correspond pas à un lundi !"
    Else
         Call UserForm_Calendrier.Modify(GarderOuvert:=False)
         MsgBox Format(DateChoisie, "dddd dd mmmm yyyy")
    End If
End Sub

'-----------
'Test simple
'-----------
Sub TestSimple()
    Call PositionSousBouton(ActiveSheet.Shapes("Bouton Simple"), Left, Top)
 
    Call UserForm_Calendrier.Display(Texte:="Saisir une date d'un lundi", _
                                     Left:=Left, Top:=Top, _
                                     FonctionSurChoixUtilisateur:="FonctionLundi")
End Sub

'-----------------------------
'Fonction utilisateur sur date
'-----------------------------
Sub FonctionLundi(DateChoisie As Date)
    If DateChoisie = 0 Then
        'Fermer le UserForm
        Call UserForm_Calendrier.Modify(GarderOuvert:=False)
    ElseIf Weekday(DateChoisie, 2) <> 1 Then
        MsgBox "La date saisie ne correspond pas à un lundi !"
        Call UserForm_Calendrier.Modify(GarderOuvert:=True)
    Else
         Call UserForm_Calendrier.Modify(GarderOuvert:=False)
         MsgBox Format(DateChoisie, "dddd dd mmmm yyyy")
    End If
End Sub

'-----------
'Test avancé
'-----------
Sub TestAvancé()
    Range(CelluleDate1).Value = ""
    Range(CelluleDate2).Value = ""
   
    Call PositionSousObjet(Range(CelluleDate1), Left, Top)
   
    Call UserForm_Calendrier.Display(Texte:="Saisir la 1ère date", _
                                     Left:=Left, Top:=Top, _
                                     TargetObject:=Range(CelluleDate1), _
                                     TargetObjectEnglishDateFormat:="ddd dd mmm yyyy", _
                                     FonctionSurChoixUtilisateur:="FonctionDate1", _
                                     GarderOuvert:=True)
End Sub

'----------------------------------
'Fonction utilisateur sur 1ère date
'----------------------------------
Sub FonctionDate1(DateChoisie As Date)
    If DateChoisie = 0 Then
        MsgBox "Veuillez choisir une date non nulle !"
    Else
        Date1 = DateChoisie
        Call PositionSousObjet(Range(CelluleDate2), Left, Top)

        Call UserForm_Calendrier.Modify(Texte:="Saisir la 2ème date", _
                                        Left:=Left, Top:=Top, _
                                        TargetObject:=Range(CelluleDate2), _
                                        FonctionSurChoixUtilisateur:="FonctionDate2")
    End If
End Sub

'----------------------------------
'Fonction utilisateur sur 2ème date
'----------------------------------
Sub FonctionDate2(DateChoisie As Date)
    If DateChoisie = 0 Then
        MsgBox "Veuillez choisir une date non nulle !"
    ElseIf Date1 > DateChoisie Then
        MsgBox "Veuillez choisir une 2ème date supérieure ou égale à la 1ère !"
    Else
        Date2 = DateChoisie
        Call UserForm_Calendrier.Modify(GarderOuvert:=False)
    End If
End Sub

'------------------------------------------------
'Postion Left & Top sous l'objet pour le UserForm
'------------------------------------------------
Sub PositionSousObjet(Obj As Object, ByRef Left As Double, ByRef Top As Double)
    Dim PointToPixel As Double
    Dim PixelToPoint As Double

    With ActiveWindow.ActivePane
        PointToPixel = (.PointsToScreenPixelsX(1000) - .PointsToScreenPixelsX(0)) / 1000
        PixelToPoint = 1 / PointToPixel
    End With
   
    Left = ActiveWindow.ActivePane.PointsToScreenPixelsX(Obj.Left) * PixelToPoint
    Top = ActiveWindow.ActivePane.PointsToScreenPixelsY(Obj.Top) * PixelToPoint + Obj.Height
End Sub