VBA Excel [Alle versies] - Kalenderbeheer

Invoering

Het kalenderbeheer van VBA is gewijzigd tussen Excel 2003 en Excel 2010. De oudere versies hebben een besturingselement met de naam " Kalender " en voor de nieuwe versies wordt dit het besturingselement " DT Picker " genoemd. Compatibiliteitsproblemen kunnen optreden wanneer u probeert te gebruiken:

werkmappen met het kalenderbesturingselement op de nieuwe versies van Excel
werkmappen met DT Picker op de vorige versie van Excel.

Een andere zorg ligt in de versie van Microsoft Office die wordt gebruikt. Sommige bedrijfsconfiguraties staan geen toegang toe tot het DT Picker-besturingselement. Om dit te verhelpen, raad ik aan dat u uw eigen kalenderbesturingselement maakt met behulp van een gebruikersformulier.

Het gebruikersformulier

De UserForm zal bevatten:

29 en 31 opdrachtknoppen voor de "Dagen".
Een label "Keuze van de maand".
2 knoppen ("") om tussen de maanden te navigeren.
De huidige maand en het huidige jaar worden weergegeven in de "Caption" (titel) van de UserForm.
Alle besturingselementen in dit gebruikersformulier worden dynamisch gemaakt.

Ermee beginnen

Open uw VBA-editor, maak een nieuw UserForm en verander de eigenschap Name in "Calendrier".

Kopieer de onderstaande code in de module van de UserForm:

 Optie Expliciet Privé Sub UserForm_Initialize () Dim Obj As Control Dim i Integer, Mois As Integer, Annee As Integer Dim Cl As Classe1 'Création Changement de mois' LABEL Set Collect = Nieuwe verzameling Set Obj = Me.Controls.Add ("forms .Label.1 ") Met Obj .Name =" LbChoixMois ".Object.Caption =" Choix du mois: ".Left = 5 .Top = 5. Breedte = 70. Hoogte = 10 Einde met 'BOUTONS Obj = Me instellen. Controls.Add ("forms.CommandButton.1") With Obj .Name = "MoisPrec" .Object.Caption = "" .Left = 95. Top = 1. Breedte = 20. Hoogte = 20 Einde met set Cl = nieuwe Classe1 Stel 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. Breedte = 20. Hoogte = 10 Einde met Volgende i 'création boutons "jours" Mois = Month (Date) MoisEnCours = Mois Annee = Year (Date) AnneeEnCours = Annee CreationBoutonsJours Mois, Annee Indien Links (Format (Datum, "dd"), 1) = "0" Then Me.Controls ("Bouton" & Format (Datum, "d")). SetFocus Else Me.Controls ("Bouton" & Indeling (Datum, "dd")). SetFocus End Sub

Maak de knoppen

Het aantal dagen varieert van de ene maand tot de andere, dus we zullen ze op een dynamische manier maken. Hiervoor een procedure die we nodig hebben:

Verwijder de oude knoppen
Maak nieuwe knoppen op basis van de maand en het jaar.

Maak een module (Invoegen> Module) en kopieer de onderstaande code:

 Optie Expliciet Openbaar met gebeurtenissen Bouton als MSForms.CommandButton Privé Sub Bouton_Click () Selecteer Case Bouton.Name Case "MoisPrec" MoisEnCours = MoisEnCours - 1 Als 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 End Select CreationBoutonsJours MoisEnCours, AnneeEnCours End Sub

De klassemodules

We moeten een klassenmodule maken om de opdrachtknoppen te laten werken.

Om te navigeren tussen maanden:

 Optie expliciet publiek met gebeurtenissen Btn als 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 Privé 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) of Paques (Year (maDate)) = maDate Then Btn.ControlTipText = QuelFerie (maDate) End Sub

De klassemodule voor de dagen

 Optie expliciet publiek met gebeurtenissen Btn als 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 Privé 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) of Paques (Year (maDate)) = maDate Then Btn.ControlTipText = QuelFerie (maDate) End Sub

Beheer van feestdagen

In de standaardmodule die eerder is gemaakt, zullen we drie functies toevoegen om feestdagen te identificeren.

Een functie die de vakantie retourneert als een tekenreeks

 '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 Functie If Jour = CDate (maDate + 50) Then QuelFerie = "Lundi de Pentecôte": Exit Functie If Jour = CDate (maDate + 39) Then QuelFerie = "Jeudi de l'ascension": Exit Functie a = Year (Jour): m = Month (Jour): j = Dag (Jour) Selecteren Case m * 100 + j Case 101 QuelFerie = "1er Janvier": Exit Functie Case 501 QuelFerie = "1er Mai": Exit Functie Case 508 QuelFerie = "8 Mai": Exit Functie Case 714 QuelFerie = " 14 Juillet ": Exit Functie Case 815 QuelFerie =" 15 Août ": Exit Functie Case 1101 QuelFerie =" 1er Novembre ": Exit Functie Case 1111 QuelFerie =" 11 Novembre ": Exit Functie Case 1225 QuelFerie =" Noël ": Einde Functie Einde Selecteer Eindfunctie

Een functie die de feestdagen identificeert

 'SOURCES:' //blog.developpez.com/philben/p11458/vba-access/sagit-il-dun-jour-ferie Public Function EstJourFerie (ByVal laDate As Date, Optioneel ByVal EstPentecoteFerie As Boolean = True) Als Booleaanse '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 november - 1111 = 11 Novembre - 1225 = 25 Decembre '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 - Vrij om Statische annee te gebruiken als integer, dPa als datum, dAs als datum, dPe als datum, bPe als Booleaanse dim a als integer, m als geheel getal, j als geheel getal a = jaar (laDate) : m = Maand (laDate): j = Dag (laDate) Selecteer 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: Dat e 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 Anders dPe = # 1/1 / 100 # Einde Als Selecteer zaak DatumSerial (a, m, j): Geval dPa, dAs, dPe: EstJourFerie = Waar: Einde Selecteer Einde Selecteer Eindfunctie