XL 2019 Saisir automatiquement des dates au moyen d'un calendrier

[Magic_Doctor]

Bonsoir,

Ma fille en avait besoin pour son travail : dans une colonne de cellules qui ne reçoivent que des dates, quand on clique sur l'une de ces cellules, faire apparaître un petit calendrier à partir duquel on choisirait une date qui s'inscrirait dans la cellule.
J'ai cherché un peu partout, mais rien qui correspondait à ce que je voulais exactement. Je décide de résoudre le problème avec l'humanoïde. En moins de 2 minutes il me le résout sommairement, puis des heures d'échanges et d'essais pour peaufiner cette histoire et que surtout ça ne plante pas.
Résultat : bluffant.
Mais, je dois reconnaître, histoire complexe dont plusieurs procédures me dépassent. Ce n'est pas grave, l'essentiel, c'est que ça marche.
Je partage, et si quelqu'un peut trouver plus simple pour au moins le même résultat, je suis preneur.

¡FELIZ AÑO NUEVO A TODOS!

 

[patricktoulon]

Bonjour à tous
@Rheeem
et voici la version 3.3 ou l'on peut mettre un peu de couleur en mode édition dans le VBE

 

[Rheeem]

Bonsoir,

L'idée est bonne comme pas mal d'autres personnalisation qui sont envisageables concernant la validité des dates la possibilité de changer l'année / le mois pour restreindra la sélection , à mon avis c'est un mouvais choix que le jeu de couleur par défaut soit basé sur le gris , personne n'aime donner à son calendrier le look d'un vieux os.

 

[patricktoulon]

Bonjour @Rheeem
Change le avec les bouton dans le vbe

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers

 

[Rheeem]

Bonsoir,

Cette version c'est mieux on laisse le style du système par défaut car il y aura peu qui vont changer cette configuration, j'ai un autre remarque dans cette version et la précédente tu as ré-introduits un bug qui concerne la position du dialogue au lancement actuellement StartUpPosition force la position au center de l'écran et ne tient pas compte de la position indiquée dans Initialize et cela crée un effet visuel désagréable le dialogue s'affiche pour un laps de temps au centre de l'écran avant de prendre sa position.
Au début de Initialize ajouter :
StartUpPosition = 0
et à la fin de Activate remets ces lignes :

  If Left = 0 Then
     Move (Application.Width - Width) / 2, (Application.Height - Height) / 2
  End If

 

[patricktoulon]

bonjour @rheem
le mode center est necessaire pour les appels sans appelant
je pourrais eventuellement faire un switch dans le callback datevaluex

c'est quand même etonnant je n'ai pas cet effet chez moi le calendar apparait directement a l'endroit demandé

 

[patricktoulon]

voila la fonction avec le switch pour le startupposition

'callback pour la classe calendrier
Public Function DateValueX(Optional obj As Object = Nothing, Optional langue As Long = -1)
    Dim forme
    With Calendrier
       If obj Is Nothing Then
       .StartUpPosition = 1
       Else
      .StartUpPosition = 0
      End If
       .DateSepar = Switch(langue = 0, "/", langue = 2, "-", langue = 1, "/", langue = -1 Or langue > 2, Application.International(xlDateSeparator))
        .DateOrder = Switch(langue > -1, langue, langue = -1 Or langue > 2, Application.International(xlDateOrder))
        If Not obj Is Nothing Then
            Set .obj = obj
            Select Case TypeName(obj)
                Case "Range"
                    If IsDate(obj.Value) Then .dat = CDate(obj.Value) Else dat = Date
                    oldate = obj.Value
                Case "TextBox"
                    If IsDate(obj.Text) Then .dat = CDate(obj.Text) Else dat = Date
                    oldate = obj.Text
                Case "Label", "CommandButton"
                    If IsDate(obj.Caption) Then .dat = CDate(obj.Caption) Else dat = Date
                    oldate = obj.Caption
                Case "Shape", "DrawingObject"
                    If IsDate(ActiveSheet.DrawingObjects(obj.Name).Text) Then .dat = CDate(ActiveSheet.DrawingObjects(obj.Name).Text) Else dat = Date
                    oldate = ActiveSheet.DrawingObjects(obj.Name).Text
                Case Else: dat = Date 'au cas ou l'appelant n'est pas identifié
            End Select
        Else
            dat = Date
        End If
        
        If obj Is Nothing Then Me.StartUpPosition = 1
        Show
        Select Case .DateOrder
            Case 0, 2: forme = "yyyy" & .DateSepar & "mm" & .DateSepar & "dd"
            Case 1: forme = "DD" & .DateSepar & "mm" & .DateSepar & "yyyy"
        End Select
        If .Tag <> "no" Then
            Select Case TypeName(obj)
                Case "Range"
                    DateValueX = dat
                    If langue > -1 Then obj.NumberFormat = forme
                Case "TextBox", "Label", "CommandButton", "Shape"
                    DateValueX = Format(dat, forme)
                Case Else: DateValueX = dat
            End Select
        Else
            DateValueX = oldate 'si on ferme par la croix on remet ce qu'il y avait
        End If
        Unload Calendrier
    End With
End Function

si tu a toujours cet effet de deplacement du centre vers sa position demandé on placera le userform avant affichage

 

[patricktoulon]

re : @Rheeem
voila maintenant le left et top du calendrier son decidés avant affichage
si appelant startupposition=0 et placement ,sinon 1
et les fonctions de position sont solicitées dans le callback datevaluex(avant affichage)

 

[Rheeem]

Parfait, le dernier code fonctionne correctement,

J'ai trouvé qu'on peut convertir localement les coordonnés de la souris sans passer par GetCursorPos et MapWindowPoints pour simuler le clic:
Dans la prochaine mise à jour changer le code MouseDown:
hit.pt.X = X * AppDpi / 72
hit.pt.Y = Y * AppDpi / 72

 

[patricktoulon]

Bonjour @Rheeem
Ah ben oui le calendrier est child de la frame et pos 0,0
Donc le x et y de l'event userform sont bons, il ne reste plus qu'à effectuer leur transformation en pixels.
Tu as raison sur la logique autant alimenter hit.pt directement
du coup version 4
J'en ai profité pour mettre à jour les fonctions de placemenRange et activxsheet
quand on est sur la dernière colonne visible du range et si il n'y a pas assez de place à droite , Le calendrier ne couvre plus l'appelant il se place à gauche.

 

[Magic_Doctor]

Bonjour,

J'ai repris le calendrier de patricktoulon et y ai fait quelques rajouts :
- fermer le calendrier avec touche Esc
- possibilité d'effacer la date
- prénoms
- équinoxes | solstices
- changements d'heure
- les 3 grandes fêtes musulmanes
- Lunaisons
- lever & coucher du soleil
- possibilité de changer de pays directement à partir du calendrier (cliquer tout à gauche de la pseudo barre de titre du calendrier)

 

[patricktoulon]

c'est pas mal du tout @Magic_Doctor
mais ca n'entre plus dans le dialog autonome puisque l'on est dependant d'un 2d userform et même d'un autre module
deplus les date fetes mulsulmanes ne sont pas calculées elle sont en dur dans le code du module
mais tu m'a donné une idée et je vais le refaire au propre et autonome
donne moi la règle pour les calculer

 

[Magic_Doctor]

Je sais bien. Tout mettre dans un seul module UF serait le plus pratique.
J'ai dû créer un module standard pour y caser les APIs Windows nécessaires à la suppression de la barre de titre du formulaire qui devenait totalement inutile, même inesthétique.
Le truc sympa est de pouvoir voir les lunaisons & tutti quanti en survolant les cases jours du calendrier. Ça sert pas à grand-chose, mais c'est bô !
Quant aux dates des fêtes musulmanes, comme ça dépend du calendrier lunaire, il semblerait qu'il n'y ait pas de formule les donnant exactement. J'avais entendu dire que c'était un truc un peu tordu, les Immams les déclarant officiellement, chaque année, un peu avant leur célébration.
C'est sûr que ce calendrier pourrait être encore amélioré (et pourquoi pas simplifié) dans la rédaction des procédures.
Que manque-t-il maintenant ? Peut-être les principales fêtes juives.

 

[patricktoulon]

bon j'ai regardé un peu,, ton chatgpt a foutu un bordel monstre
j'avoue je n'aime pas trop ce qui a été fait dans le code
pour l'instant 1 module supprimé il n'y a pas besoin de toute ces api pour enlever la barre de titre
j'aurais vraiment préféré que tu fasse ça sur un autre calendar
ou que tu me donne tes idées je t'aurais dit comment faire

il faut prendre en compte aussi c'est qu'a partir du moment ou on met les api en jeu Pour MAC c'est fini

les idées sont bonnes mais le code est pouri (du chatgpt tout craché ça)

 

[Magic_Doctor]

bon j'ai regardé un peu,, ton chatgpt a foutu un bordel monstre
j'avoue je n'aime pas trop ce qui a été fait dans le code
pour l'instant 1 module supprimé il n'y a pas besoin de toute ces api pour enlever la barre de titre
j'aurais vraiment préféré que tu fasse ça sur un autre calendar
ou que tu me donne tes idées je t'aurais dit comment faire

il faut prendre en compte aussi c'est qu'a partir du moment ou on met les api en jeu Pour MAC c'est fini

les idées sont bonnes mais le code est pouri (du chatgpt tout craché ça)

Le but que je m'étais fixé était de concrétiser comment je l'imaginais ton calendrier. Et, ma foi, ça marche.
Que l'humanoïde n'ait (pour l'instant) pas la dextérité de l'humain pour résoudre ce type de problème, ça on le savait.
Dans mon précédent post, j'avais bien souligné :

C'est sûr que ce calendrier pourrait être encore amélioré (et pourquoi pas simplifié) dans la rédaction des procédures.

En effet, les solutions de ChatGPT sont très souvent lourdes, très lourdes.
Je sais bien que les APIs Windows ne fonctionnent pas sur Mac. Personnellement je m'en fous, n'utilisant jamais Mac avec tout son univers fermé et coûteux (même si c'est beau, geek et que ça marche bien). Qu'il y ait maintenant un module en moins, c'est super, ça prouve qu'on est sur la bonne voie de la simplification.

L'essentiel, c'est que ces rajouts dans ton calendrier te donnent des idées pour les reprendre proprement. Après tout, n'est-ce pas là l'intérêt d'un forum, partager des idées ?
J'ai regardé ta correction. Tu as forcé sur la taille de police du gros label.

PS : j'avais essayé de mettre les drapeaux dans le formulaire Calendar, je ne sais pas pourquoi, mais gros bordel.

 

[patricktoulon]

tiens regarde poure coup j'ai commencé
et en effet il y avait un soucis avec tes images j'ai du en télécharger d'autres

Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.

Accepter les cookies de tiers