Date Picker

Retour vers Excel

J'ai découvert une petite pépite sur ce site où l'on retrouve ce fichier samradapps_datepicker parce que curieusement on ne retrouve plus cette option sur les versions modernes d'Excel (les méandres des esprits chez Microsoft sont parfois difficiles à suivre  🙄 ) Décompressez-le pour récupérer le fichier samradapps_datepicker.xlam 

La page en lien doit dater de Windows 7, il y a donc des petites différences avec Windows 10. Allez voir les captures d'écran,  elles sont explicites sur les avantages de cette fonction qui va s'ajouter au ruban et sera disponible pour tous les classeurs

Ainsi le chemin d'installation est C:\Program Files\Microsoft Office\NomdeVotreVersion\XLSTART et plus dans Program Files (x86). Mais en fait, ce n'est pas obligatoire, ça fonctionne aussi avec un autre dossier, mais il est logique de le placer à cet endroit et l'auteur dit que certaines personnes ont rencontré des soucis pour le charger. Donc suivons son conseil !

Windows va  produire un avertissement quand vous allez copier samradapps_datepicker.xlam dans xlstart, cliquez simplement sur "Continuer" (Remarque : ne le décompressez pas directement dans xlstart, la sécurité de Windows va refuser de le faire. Décompressez le dans un dossier temporaire et ensuite faites un copier-coller dans xlstart)

Ensuite, comme indiqué, on va dans l'onglet "Fichiers" puis "Options" puis "Compléments" et là le bouton à utiliser se nomme maintenant "Atteindre". Dans la fenêtre qui apparaît alors cliquez sur "Parcourir" et l'on désigne le fichier qui se trouve dans xlstart

On retrouve alors le bouton "Date Picker" dans le ruban

Il suffit de se positionner sur une cellule et de cliquer sur ce nouveau bouton pour insérer la date (par défaut date du jour); Il y a 2 petites commandes supplémentaires dont notamment le clic DROIT où une première commande supplémentaire "Date Picker" est venue s'ajouter dans le menu contextuel 

Cela ajoute donc une date dans la cellule sélectionnée, par défaut, cela affiche l'année avec 2 chiffres, pour changer cela il suffit de faire un clic droit sur la cellule - propriétés et de choisir un autre format. Eventuellement appliquez ce format à toute la colonne

Vidéo explicative, en anglais mais les images sont explicites

Maintenant que l'on sait comment l'installer, nous constatons plusieurs choses :

  1. La petite icône qui permet d'utiliser le date picker depuis une cellule n'est visible qu'après avoir entré une date dans la cellule, déplacer le curseur et revenir ensuite sur la cellule contenant la date.
  2. Elle n'apparaît pas non plus si l'on définit les propriétés de la cellule (avec un clic droit - propriétés - format de la cellule) au format "Date" même après un déplacement et un retour.
  3. Le script VBA modifie le format de la cellule  et celui-ci est conservé par Excel même si on efface une date introduite auparavant mais l'icône n'apparaît plus (Cfr point 2) . Donc si vous entrez une donnée numérique dans cette cellule vous obtiendrez l'affichage d'une date comme par exemple 30250 donnera 26-10-1982 
  4. Si une date est introduite même manuellement l'icône apparaîtra aussi dans la cellule en dessous permettant des saisies successives.

Dans l'exemple suivant, nous allons automatiser la recherche d'une donnée en colonne B et remplir la colonne D avec la date du jour, faire un déplacement, un retour. De cette façon, si la date du jour ne nous convient pas, il ne restera qu'à cliquer sur la petite icône pour changer la date

Pour cela, on construit le formulaire et on utilisé l'événement après mise à jour de la liste déroulante

Private Sub cbx_Recherche_Change()
Sheets("ETIKETTEN").Activate 'obligatoire car le focus doit être sur la page pour retrouver la valeur
For Each cel In Range("B2:B500")
    If cel = cbx_Recherche Then
        cel.Select 'le curseur va se positionner sur la valeur sélectionnée dans la combobox
    End If
Next
Application.ScreenUpdating = False
    macellule = ActiveCell.Offset(0, 2).Address 'mais on récupére son adresse car le curseur est en fin de la source de la combobox
    'ici on vide les contenus du formulaire
    cbx_Recherche = ""
    Unload UserForm1 'on décharge le formulaire puisqu'on n'en a plus besoin
    Range(macellule).Select 'on repositionne le curseur en colonne G
    Range(macellule) = Date 'on met la date du jour pour formater la cellule
    Range(macellule).NumberFormat = "d/mm/yyyy;@" 'on donne ce format à la date
    Range(macellule).Offset(0, 1).Select 'pour obtenir l'icône du date picker, on doit déplacer le curseur
    Range(macellule).Select 'et ensuite on revient  en colonne G
Application.ScreenUpdating = True
End Sub

Cliquez ici pour télécharger le fichier exemple

Et pour les formulaires ? On peut s'y prendre autrement aussi. Généralement on tapera simplement la date dans une TextBox (Zone de texte) Voici un exemple :

  • On crée un formulaire via ALT+F11 pour arriver dans l'éditeur VBA (=VBE), on se place sur ThisWorkBook, clic droit - insertion - userform. On obtient alors un UserForm1, on modifie sa propriété Caption en "Recherche et Insertion" .
  • On crée sur notre feuille un bouton (attention, toujours utiliser des contrôles ActiveX, les contrôles Formulaires sont obsolètes) qui va appeler notre formulaire avec le code
Private Sub bt_Formulaire_Click()
    'Pour afficher/ouvrir le formulaire
 UserForm1.Show
End Sub
  • Sur le formulaire on pose 3 contrôles une liste déroulante, une zone de texte, un bouton
  • La liste déroulante va afficher les données d'une colonne qui nous serviront comme critère de recherche 
Private Sub cbx_Recherche_Change()
'Sheets("ETIKETTEN").Activate 'préférable car le focus est ainsi sur la page pour retrouver les valeurs
For Each cel In Range("B2:B500")
    If cel = cbx_Recherche Then
        cel.Select 'le curseur va se positionner sur la valeur sélectionnée dans la combobox
        ' ActiveCell.Offset(0, 2) = Format(Date, "d/m/yyyy") 'si on souhaite insérer la date du jour alors cette zone de liste peut être utilisée seule End If Next End Sub
  • La zone de texte nous permet de saisir une date. Il faut l'entrer avec 2 chiffres pour le jour car à ce stade Excel ne peut pas deviner que vous allez taper, par exemple 2 ou 24; idem pour les mois par exemple 1 ou 11 (janvier ou novembre ?) donc la zone de texte présentera une saisie sous la forme, par exemple, 02/05/2021.
    On en automatise un peu la saisie en ajoutant les barres obliques entre le jour et le mois et on vérifie si la valeur du jour est au moins comprise entre 1 et 31 et le mois entre 1 et 12, On y ajoute automatiquement l'année en cours. Quand la date est complète, on effectue un contrôle final pour vérifier si cette date est valide. Il ne faudrait pas par exemple entrer un 31/02/2021 (février)
Private Sub tb_D_Change()
If tb_D.TextLength = 2 Then
'ici on contrôle si les jours sont bien entre 1 et 31 mais on peut encore écrire 31/02/2021 ce qui est impossible
'on signale cela au contrôle final
    If CInt(tb_D.Value) < 1 Or CInt(tb_D.Value) > 31 Then
        reponse = MsgBox("Le jour doit être compris entre 1 et 31. Recommencez !", vbOKOnly, "Attention")
        tb_D = ""
        Exit Sub
    End If
tb_D = tb_D & "/" 'ceci permet d'entrer le caractère / à notre place en colonne D
End If
If tb_D.TextLength = 5 Then
    'ici on contrôle si le mois est plausible donc entre 1 et 12
    If CInt(Mid(tb_D.Value, 4, 2)) < 1 Or CInt(Mid(tb_D.Value, 4, 2)) > 12 Then
        reponse = MsgBox("Le mois doit être compris entre 1 et 12. Recommencez !", vbOKOnly, "Attention")
        tb_D = ""
        Exit Sub
    End If
    tb_D = tb_D.Text & "/" & Year(Date)
End If
'contrôle final
'pour voir que les jours sont bien entre 0 et 28,30 ou 31 jours suivant les mois
If tb_D.TextLength = 10 Then
    On Error Resume Next
    If DateValue(tb_D) = DateSerial(CInt(Left(tb_D, 2)), CInt(Mid(tb_D, 4, 2)), CInt(Right(tb_D, 4))) Then
    End If
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Date incorrecte, Recommencez !"
        tb_D = ""
        Exit Sub
    End If
End If
End Sub
  • Finalement, nous refermons le formulaire et insérons la date dans une colonne adjacente à la valeur que l'on a sélectionnée via la zone de liste déroulante. Comme il peut y avoir des petits malins qui cliquent sur ce bouton Fin sans entrer de date dans la zone de texte, on produit un message d'avertissement, l'utilisateur peut alors faire le choix de stopper et corriger son action ou de supprimer la date précédemment entrée dans la cellule de la feuille
Private Sub cmdFin_Click()
'Pour cacher le Formulaire
Application.ScreenUpdating = False 'pour éviter que l'écran ne saute
If tb_D.Value <> "" Then
    ActiveCell.Offset(0, 2) = Me.tb_D.Value 'on formate la valeur de la textbox (car c'est du texte) en date
    ActiveCell.Offset(0, 2).NumberFormat = "d/m/yyyy" 'ceci pour avoir le jour et le mois avec un seul chiffre
Else
    'si on ne remplit pas tb_D
    reponse = MsgBox("Vous ne voulez pas définir de valeur pour la colonne D, son contenu sera effacé", vbYesNo, "Attention")
    If reponse = vbYes Then
        Exit Sub ' on sort de la procédure ainsi on peut encore entrer quelque chose dans tb_D
    Else
        ActiveCell.Offset(0, 2) = Format(Me.tb_D.Value, "d/m/yyyy") 'sinon, bin tant pis, cela va effacer le contenu de la cellule en colonne D
    End If
End If
    'macellule = ActiveCell.Offset(0, 2).Address 'mais on récupére son adresse car le curseur est en fin de la source de la combobox
    reponse = MsgBox("Les valeurs sont modifiées", vbonly, "Terminé") 'on avertit l'utilisateur
    'ici on vide les contenus du formulaire
    cbx_Recherche = ""
    tb_D = ""
    Unload UserForm1 'on décharge le formulaire puisqu'on n'en a plus besoin
    'Range(macellule).Select
    Range("G1").Select 'on repositionne le curseur en colonne G
    Application.ScreenUpdating = True 'remettre l'écran
End Sub

Cliquez ici pour télécharger le fichier exemple