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

[Dudu2]

Dudu2 a soumis une nouvelle ressource:

VBA - Calendrier sur la base d'un UserForm - Une fonction à appeler pour choisir une date dans le calendrier

Le fichier à télécharger contient:

1. Le UserForm Calendrier à importer dans le projet VBA.
2. Le Module_Test qui donne quelques exemples d'utilisation.

L'appel de la fonction:

Dim DateChoisie as Date
'
DateChoisie = UserForm_Calendrier.Display(...voir la description des paramètres dans le code...)

Les principales caractéristiques du calendrier:

• ...

En savoir plus sur cette ressource...

 

[fanch55]

Dudu2 a soumis une nouvelle ressource:

VBA - Calendrier sur la base d'un UserForm - Une fonction à appeler pour choisir une date dans le calendrier

Salut @Dudu2 ,
Petit problème dans le classeur exemple en utilisation Simple et Avancée :
On ne peut pas sortir de l'Userform sans que la date soit valide ( la croix ne remplit pas sa fonction basique ni les boutons )
En utilisation avancée, l'userform devrait se positionner sur la date2 quand elle est demandée ...

 

[Dudu2]

Bonjour @fanch55,

Oui, c'est volontaire. Le contrôle dans la Module_Test est programmé comme ça.
Exemple du Simple:

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

Pour plus de flexibilité j'aurais dû coder:

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

La différence réside dans ce que la Fonction Utilisateur (ici FonctionLundi) fait lorsqu'elle reçoit en paramètre une date nulle.

 

[Dudu2]

En utilisation avancée, l'userform devrait se positionner sur la date2 quand elle est demandée ...

Dans le Module_Test, j'ai positionné le UserForm en dessous du bouton correspondant.
Toutefois, si on peut passer en paramètres du Calendrier les Left et Top du UserForm, c'est au programme appelant de valoriser ces 2 paramètres en fonction du positionnement souhaité.

Pour réaliser le positionnement auquel tu fais référence, le code devrait être celui-là.

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

 

[fanch55]

Ok,Ok,
Je me doutais bien que c'était à programmer lors des appels .

Il faudrait peut-être réduire la taille de la police qui "déborde" pour les boutons jours

 

[Dudu2]

Je me suis basé sur ce que je vois sur ma config Windows 10 + Office 2016 qui n'affiche manifestement pas les boutons de la même manière que chez toi. Tu es en quelles versions ?

 

[fanch55]

Windows 11 + Office 2019 + Ecran 27pouces ( 1920x1080 )
Testé aussi sur un
W10 + Office 2019 + Ecran 17pouces ( 1920x1080 ) même symptômes ...

J'ai modifié les font.size des boutons à 10 ( originellement à 11 ) , semble ok pour moi ...

 

[Dudu2]

Étrange, la Font.Size des boutons jours est originellement à 10. Je ne comprends pas qu'elle soient à 11 chez toi !? Je viens de vérifier en téléchargeant le fichier des ressources !
Ça me parait délirant que Office 2019 change la taille de la Font.
Je vais devoir la forcer dans le code ?!?

 

[fanch55]

Dans le classeur téléchargé chez moi:
La font par défaut chez moi est Tahoma/8 (dérivée du font.size de l'userform)
Toi 2016, moi 2019, La police aurait été celle par défaut, j'aurai admis, mais pourquoi 10 chez toi et 11 chez moi ? si j'en fait un debug.print, j'ai la valeur 10.2 ?

 

[Dudu2]

Oui, chez moi aussi Tahoma 8.
Je ne comprends pas que Office 19 change la taille de la Font.

 

[Dudu2]

J'ai forcé 10 sur tous les Controls dans le code.
Tu peux essayer STP ?

 

[fanch55]

Impec

 

[Dudu2]

Merci pour ton retour.
J'ai aussi modifié le SIMPLE selon ta remarque pour pouvoir le fermer.
L'AVANCÉ garde l'obligation de saisie en tant qu'exemple maintenant mentionnée dans le bouton, et profite d'un déplacement en douceur du UserForm pour faire joli.

Maintenant je sais pas trop quoi faire.
Soit je supprime cette ressource et j'en recréé une autre à l'identique, soit je fais une mise à jour mais je sais pas trop ce que ça veut dire.

 

[fanch55]

Étant donné qu'il y a un historique dans la ressource avec des versions,
je pense que tu peux faire une V2.
Je ne sais pas comment , je suis juste en consultation dessus ( normal ) .

 

[Dudu2]

Oui je peux, mais c'est plus une correction de problème que tu as trouvé qu'une nouvelle version.
Je pense que je vais RAZ le bidule.