VBA Excel [toutes versions] - Contrôle calendrier transposable

- Introduction
- L'UserForm
- La procédure de création des boutons
- Les modules de classe
- Les fonctions "Jours fériés"
- Paramétrage des couleurs
- Paramétrage des couleurs version 2
- Téléchargements
Introduction
En VBA, le contrôle calendrier a changé entre les versions d'Excel 2003 et Excel 2010. Les anciennes versions comportent un contrôle nommé "Calendar", les nouvelles versions, le contrôle DT Picker.Le souci de la portabilité d'un classeur que l'on créé, d'un ordinateur à un autre, se pose alors. Comment utiliser mon contrôle Calendar dans les nouvelles versions et comment utiliser le DT Picker dans les anciennes?
Un autre souci réside dans l'installation de votre pack Office. Certaines configurations d'entreprise ne permettent pas l'accès au contrôle DT Picker.
Pour remédier à cela, je vous propose de créer vous même votre propre contrôle calendrier, en utilisant un Userform.
Nota : Une nouvelle version de ce calendrier est disponible en téléchargement (version 4.xx). Elle permet de s'affranchir de deux des trois modules, en n'utilisant qu'un unique module de Classe.
Pour cette version, vous pouvez consulter cette fiche pratique.
L'UserForm
Celui-ci devra comporter entre 29 et 31 boutons de commande "Jours" et 4 boutons de commande (">>", ">", "<<" et "<") permettant le changement d'année et/ou de mois. Le mois et l'année "en cours" seront quand à eux, affichés dans le "Caption" (titre) de l'userform. Tous les contrôles, à l'intérieur de cet UserForm, seront créés dynamiquement. Vous n'aurez donc pas à les dessiner. De même, la taille importe peu car elle sera fonction du nombre de boutons et de leur disposition dans l'UserForm Calendrier.Sous votre Editeur VBA, créez un nouvel Userform, et changez sa propriété Name en "Calendrier".
Dans le Module de cet UserForm, placez le code suivant :
Option Explicit Private Sub UserForm_Initialize() Dim Obj As Control Dim i As Integer, Mois As Integer, Annee As Integer Dim Cl As ClasseBtnChange 'Création Boutons Changement de mois et d'année Set Collect = New Collection 'BOUTONS : '- < et > = mois '- >> et << = année Set Obj = Me.Controls.Add("forms.CommandButton.1") With Obj .Name = "AnneePrec" .Object.Caption = "<<" .Left = 27 .Top = 1 .Width = 20 .Height = 20 End With Set Cl = New ClasseBtnChange Set Cl.Bouton = Obj Collect.Add Cl Set Obj = Me.Controls.Add("forms.CommandButton.1") With Obj .Name = "MoisPrec" .Object.Caption = "<" .Left = 50 .Top = 1 .Width = 20 .Height = 20 End With Set Cl = New ClasseBtnChange Set Cl.Bouton = Obj Collect.Add Cl Set Obj = Me.Controls.Add("forms.CommandButton.1") With Obj .Name = "MoisSuiv" .Object.Caption = ">" .Left = 75 .Top = 1 .Width = 20 .Height = 20 End With Set Cl = New ClasseBtnChange Set Cl.Bouton = Obj Collect.Add Cl Set Obj = Me.Controls.Add("forms.CommandButton.1") With Obj .Name = "AnneeSuiv" .Object.Caption = ">>" .Left = 98 .Top = 1 .Width = 20 .Height = 20 End With Set Cl = New ClasseBtnChange Set Cl.Bouton = Obj Collect.Add Cl 'Création entête Jours de la semaine For i = 1 To 7 Set Obj = Me.Controls.Add("forms.Label.1") With Obj .Name = "Jour" & i .Object.Caption = UCase(Left(Format(DateSerial(2014, 9, i), "dddd"), 1)) .Left = 20 * (i - 1) + 5 .Top = 25 .Width = 20 .Height = 10 End With Next i 'création boutons "jours" Mois = Month(Date) MoisEnCours = Mois Annee = Year(Date) AnneeEnCours = Annee CreationBoutonsJours Mois, Annee If Left(Format(Date, "dd"), 1) = "0" Then Me.Controls("Bouton" & Format(Date, "d")).SetFocus Else Me.Controls("Bouton" & Format(Date, "dd")).SetFocus Set Cl = Nothing End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Set CollecBtnJours = Nothing Set Collect = Nothing End Sub
La procédure de création des boutons
Comme nous ne connaissons pas, à la base, le nombre de boutons "Jours" à créer, nous allons les créer dynamiquement. Pour cela, il nous faut une procédure qui :- supprime les anciens boutons,
- créée les nouveaux en fonction du mois et de l'année.
Créez un Module (menu Insertion/Module) et placez y ce code :
Option Explicit Public Collect As Collection, CollecBtnJours As Collection Public MoisEnCours As Integer, AnneeEnCours As Integer 'Procédure de création des boutons Jours 'en fonction de l'année et du mois "en cours" Sub CreationBoutonsJours(Mois As Integer, Annee As Integer) Dim Obj As Control Dim Cls As ClasseBtnJours Dim NbJours As Integer, T As Integer, Gauc As Integer, Coul As Long, i As Integer, Taille As Integer 'Suppression de tous les boutons de commande "Jours" For Each Obj In Calendrier.Controls If Left(Obj.Name, 6) = "Bouton" Then Calendrier.Controls.Remove Obj.Name Next 'création des boutons jours en fonction de l'année et du mois "en cours" Set CollecBtnJours = New Collection NbJours = Day(DateSerial(Annee, Mois + 1, 1) - 1) For i = 1 To NbJours If i = 1 Then T = 35 Select Case UCase(Format(DateSerial(Annee, Mois, i), "dddd")) Case "LUNDI" Gauc = 0 If i <> 1 Then T = T + 20 Coul = 13037551 Case "MARDI" Gauc = 20 Coul = 13037551 Case "MERCREDI" Gauc = 40 Coul = 13037551 Case "JEUDI" Gauc = 60 Coul = 13037551 Case "VENDREDI" Gauc = 80 Coul = 13037551 Case "SAMEDI" Gauc = 100 Coul = 3754751 Case "DIMANCHE" Gauc = 120 Coul = 3754751 End Select If EstJourFerie(DateSerial(Annee, Mois, i)) Or Paques(Annee) = DateSerial(Annee, Mois, i) Then Coul = 1627780 Set Obj = Calendrier.Controls.Add("forms.CommandButton.1") With Obj .Name = "Bouton" & i .Object.Caption = i .Left = Gauc .Top = T .Width = 20 .Height = 20 .Object.BackColor = Coul End With If i = NbJours Then Taille = Obj.Top + Obj.Height + 20 Set Cls = New ClasseBtnJours Set Cls.Btn = Obj CollecBtnJours.Add Cls Next i With Calendrier .Caption = Format(DateSerial(AnneeEnCours, MoisEnCours, 1), "mmmm yyyy") .Tag = MoisEnCours & "/" & AnneeEnCours .Height = Taille .Width = 145 End With Set Cls = Nothing End Sub
Les modules de classe
Nous aurons besoin de deux modules de classe pour que nos boutons de commande puissent "agir".La classe des boutons suivants et précédents
Un module de classe (nommé : ClasseBtnChange) qui va gérer les boutons "<<", "<", ">" et ">>".Option Explicit Public WithEvents Bouton As MSForms.CommandButton Private Sub Bouton_Click() Select Case Bouton.Name Case "AnneePrec" AnneeEnCours = AnneeEnCours - 1 If AnneeEnCours = 1899 Then MoisEnCours = 1 AnneeEnCours = 1900 MsgBox "Première année : 1900" End If Case "MoisPrec" MoisEnCours = MoisEnCours - 1 If MoisEnCours = 0 Then MoisEnCours = 12 AnneeEnCours = AnneeEnCours - 1 If AnneeEnCours = 1899 Then MoisEnCours = 1 AnneeEnCours = 1900 MsgBox "Première année : 1900" End If End If Case "MoisSuiv" MoisEnCours = MoisEnCours + 1 If MoisEnCours = 13 Then MoisEnCours = 1 AnneeEnCours = AnneeEnCours + 1 End If Case "AnneeSuiv" AnneeEnCours = AnneeEnCours + 1 End Select CreationBoutonsJours MoisEnCours, AnneeEnCours End Sub
Nota : On voit, dans ce code, que ne sont prévues les années qu'à partir de 1900. C'est un choix délibéré en fonction des calendriers gérés par Excel. Vous pouvez tout à fait le modifier à votre convenance. Attention toutefois aux changements de calendriers dans le passé...
La classe des boutons "Jours"
Un module de classe (nommé : ClasseBtnJours) qui va gérer les boutons numérotés des jours.Option Explicit Public WithEvents Btn As MSForms.CommandButton 'Procédure lors du clic sur un bouton "jour" Private Sub Btn_Click() Dim maDate As Date maDate = CDate(Btn.Caption & "/" & Calendrier.Tag) 'La ligne suivante détermine l'action à effectuer lors d'un clic sur le bouton 'Pour entrer la date choisie dans une cellule et fermer l'Userform : 'ActiveCell.Value = maDate 'Unload Calendrier MsgBox maDate End Sub 'Affiche le nom du jour férié au survol du bouton par la souris Private Sub Btn_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) Dim maDate As Date maDate = CDate(Btn.Caption & "/" & Calendrier.Tag) If EstJourFerie(maDate) Or Paques(Year(maDate)) = maDate Then Btn.ControlTipText = QuelFerie(maDate) End Sub
Les fonctions "Jours fériés"
Dans le Module standard créé précédemment, nous allons ajouter trois fonctions. Celles-ci nous permettront d'identifier les jours fériés. Deux ne sont pas de moi, les sources ont été citées dans le code.Fonction qui retourne le jour férié en "String"
'Fonction qui retourne le jour férié en "String" 'utile pour les info-bulles au survol des jours fériés Public Function QuelFerie(Jour As Date) As String Dim maDate As Date Dim a As Integer, m As Integer, j As Integer maDate = Paques(Year(Jour)) If Jour = maDate Then QuelFerie = "Dimanche de Pâques": Exit Function If Jour = CDate(maDate + 1) Then QuelFerie = "Lundi de Pâques": Exit Function If Jour = CDate(maDate + 50) Then QuelFerie = "Lundi de Pentecôte": Exit Function If Jour = CDate(maDate + 39) Then QuelFerie = "Jeudi de l'ascension": Exit Function 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
Fonction identifiant les jours fériés
'SOURCES : 'http://blog.developpez.com/philben/p11458/vba-access/sagit-il-dun-jour-ferie Public Function EstJourFerie(ByVal laDate As Date, Optional ByVal EstPentecoteFerie As Boolean = True) As Boolean 'Détermine si la date passée en argument est un jour férié (en France) ou non : ' 101 = 1er Janvier - 501 = 1er Mai - 508 = 8 Mai - 714 = 14 Juillet ' 815 = 15 Août - 1101 = 1er Novembre - 1111 = 11 Novembre - 1225 = 25 Décembre ' dPa = Lundi de Pâques - dAs = Jeudi de l'Ascension - dPe = Lundi de Pentecôte 'Remarque : Le lundi de Pentecôte est un jour férié mais parfois non chômé (EstPentecoteFerie = False dans ce cas) 'Philben - v1.0 - 2012 - Free to use Static Annee As Integer, dPa As Date, dAs As Date, dPe As Date, bPe As Boolean Dim a As Integer, m As Integer, j As Integer 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
Fonction Dimanche de Pâques
'SOURCES : 'http://blog.developpez.com/philben/p11431/vba-access/calculer-la-date-de-paques Public Function Paques(ByVal an As Integer) As Date 'Calcul de la date du dimanche de Pâques à partir de l'année 325 'Performance par million d'appel : ' - Entre 325 et 1582 et entre 1900 et 2099 => 1/4 de seconde ' - Année supérieure à 1582 hors 1900 - 2099 => 1/2 de seconde 'Philben - v1.0 - Free to use Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer 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
Paramétrage des couleurs
Il n'est pas utile de développer ici tous les codes permettant le choix des couleurs. Je ne vais donc parler que de des codes permettant des actions spécifiques, le reste étant réellement une petite "usine à gaz".Vous pouvez dorénavant choisir vous même les couleurs de fond et de polices des différents contrôles du calendrier.
Ces paramètres de couleur sont sauvegardés à chaque clic sur le bouton "Valider".
Vous pouvez également choisir des couleurs ne faisant pas partie des couleurs supplémentaires que j'ai ajouté.
Pour cela, il suffit d'écrire le code Long de votre couleur dans le textbox, de choisir à quel endroit du calendrier vous souhaitez l'affecter (boutons d'option) et de valider. Attention toutefois, le code lié à ce TextBox n'est pas "blindé". En cas de mauvaise saisie, je ne garantis pas le résultat.
Pour accéder aux différents paramètres, clic droit soit sur le fond du calendrier, soit sur un des boutons de commande. Un clic sur "Fini" lorsque vous avez entré tous vos paramètres, redimensionne le calendrier.
Stocker une information
Pour stocker des informations pouvant servir ultérieurement, nous pouvons utiliser les cellules des feuilles Excel. Dans le cas de notre calendrier, il eut été dommage d'obliger l'utilisateur à créer une feuille dans son classeur dans le seul but de stocker 10 codes couleurs... Pour cela, j'ai choisit de stocker ces informations dans le gestionnaire des noms d'Excel.Vous stockez au préalable vos paramètres "d'origine" dans le gestionnaire de Noms :
Nouveau nom
=> zone Nom vous mettez ce que bon vous semble, exemple : Couleur_Fond_UserForm
=> zone fait référence à : vous indiquez votre code couleur à "sauvegarder", exemple : =13037551
Pour appeler ce code couleur depuis votre code, il suffit de stocker le contenu de "RefersTo" dans une variable, comme ceci :
Dim Nom As Name For Each Nom In ThisWorkbook.Names Select Case Nom.Name Case "Couleur_Fond_UserForm" 'Len(Nom.RefersTo) - 1) sert à enlever le signe "=" dans RefersTo Coul_Fond_USF = CLng(Right(Nom.RefersTo, Len(Nom.RefersTo) - 1)) Case Else End Select Next Nom
Nota : je vous ai placé ici le code dans une boucle car vous aurez certainement plus d'un paramètre à stocker.
Pour le modifier, depuis votre code VBA, il conviendra d'utiliser la syntaxe :
ActiveWorkbook.Names("Couleur_Fond_UserForm").RefersTo = "=1659755"
ou par l'intermédiaire d'une variable :
Nb =1659755 ActiveWorkbook.Names("Couleur_Fond_UserForm").RefersTo = "=" & Nb & ""
Événement Click au bouton droit de la souris
L'événement Click des CommandButton ne laisse pas le choix du bouton sur lequel vous avez cliqué. Pour avoir ce choix, il convient donc d'utiliser un autre événement : _MouseDown (ou _MouseUp). En effet, ces événements comportent dans leurs paramètres une référence au bouton cliqué :ByVal Button As Integer. Les boutons de votre souris vont tous déclencher cet événement, mais vous pourrez faire le tri dans le code lui-même. En fait, le paramètre Button peut prendre 4 valeurs constantes : xlNoButton, xlPrimaryButton, xlSecondaryButton, ou xlMiddleButton.
Nota : xlNoButton est plus utile dans l'événement MouseMove.
Exemple :
Ouvrez un nouveau classeur, insérez un UserForm et dans cet UserForm, dessinez un CommandButton. Le code de ce bouton :
Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = XlMouseButton.xlSecondaryButton Then 'action si bouton droit enfoncé MsgBox "clic droit" ElseIf Button = XlMouseButton.xlPrimaryButton Then 'action si bouton gauche enfoncé MsgBox "clic gauche" '!!!uniquement valable pour Excel 2003 (et pas valable pour les versions ultérieures) 'ElseIf Button = XlMouseButton.xlMiddleButton Then 'action si bouton du milieu enfoncé 'MsgBox "clic milieu" End If End Sub
Paramétrage des couleurs version 2
Dans cette nouvelle version vous ne serez plus obligés de saisir tous les noms dans le gestionnaire des noms d'Excel. Si vous voulez importer le calendrier dans un de vos classeurs, il vous suffira de copier les deux UserForms, le module Module1 et le module de classe Classe1. Tout le reste est automatisé.Suite à la judicieuse remarque d'Eriiic, le bouton correspondant à "aujourd'hui" est remarquable car écrit en gras.
Ces fonctionnalités sont disponibles uniquement dans la "troisième version" téléchargeable plus bas.
Fonction Paques simplifiée
Dans cette version, la fonction calculant le dimanche de Pâques a été simplifiée. La nouvelle fonction utilise une formule de calcul passée en VBA grâce à la méthode Evaluate. Cela nous donne donc une fonction personnalisée d'une seule ligne...Public Function Paques(ByVal an As Integer) As Date Paques = CDate(Evaluate("=DATE(" & an & ",3,29.56+0.979*MOD(204-11*MOD(" & an & ",19),30)- WEEKDAY(DATE(" & an & ",3,28.56+0.979*MOD(204-11*MOD(" & an & ",19),30))))")) End Function
Mode d'emploi
Intégration de ce contrôle à votre classeur
- Ouvrez les deux classeurs, le votre et celui que vous aurez choisi, ici, dans les téléchargements,
- Tapez ALT+F11 pour basculer sous l'éditeur Visual Basic,
- Dans la fenêtre VBA-Project, vous voyez les noms des classeurs ouverts :
- Double-clic sur le classeur du calendrier,
- Glissez-déplacez tout le contenu de ce classeur vers le votre (UserForms (feuilles), Module et Module de classe)
Pour configurer correctement le calendrier, voyez les commentaires de la Private Sub BoutonsJours_MouseDown dans le Module de Classe.
Paramétrage des couleurs
Le mode d'emploi est dans le classeur de démo. Je vous en mets une copie d'écran ici :
Taille du calendrier et de ses boutons
Une fois le calendrier intégré dans votre classeur, lancez le une première fois. Si les dimensions par défaut ne vous conviennent pas, allez dans le gestionnaire des noms de votre classeur (version > 2007 : Formules/Gestionnaire de noms, sous les versions antérieures, je crois qu'il se trouve dans le menu Insertion).Dans ce gestionnaire des noms, changez la valeur "fait référence à" du nom de classeur : "Large". Il est par défaut réglé à 20, mais vous pouvez l'augmenter à souhait. Attention toutefois à ne pas dépasser la taille de votre écran, 40 semble être suffisant.
Téléchargements
Voici le Classeur exemple Version 1, non paramétrable, au format .xls.Vous trouverez ICI, la version 2 qui vous laisse le choix des couleurs. Son mode d'emploi est situé juste ICI.
La troisième version, paramétrable également, est téléchargeable ICI.
Le code source de la version 4.xx est disponible ICI.
Comme d'habitude, les forums de CCM (Bureautique/Excel et Programmation/VB-VBA) sont disponibles pour toutes questions complémentaires.
N'hésitez pas.
Ce document intitulé « VBA Excel [toutes versions] - Contrôle calendrier transposable » issu de Comment Ça Marche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.