VBA Excel [Alla versioner] - Kalenderkontroll

Introduktion

Kalenderkontrollen för VBA har ändrats mellan Excel 2003 och Excel 2010. De äldre versionerna har en kontroll som heter " Kalender " och för de nya versionerna kallas den " DT Picker " -kontrollen. Kompatibilitetsproblem kan uppstå när du försöker använda:

arbetsböcker med kalenderkontrollen i de nya versionerna av Excel
arbetsböcker med DT Picker på den tidigare versionen av Excel.

En annan oro ligger i den version av Microsoft Office som används. Vissa företagskonfigurationer tillåter inte åtkomst till DT Picker-kontrollen. För att åtgärda det här föreslår jag att du skapar din egen kalenderkontroll med hjälp av ett användarformulär.

Användarformuläret

UserForm kommer att innehålla:

29 och 31 kommandoknappar för "Days".
En etikett "Månadens val".
2 knappar ("") för att navigera mellan månaderna.
Den aktuella månaden och året kommer att visas i "Formatering" (titel) i UserForm.
Alla kontroller inom denna UserForm kommer att skapas dynamiskt.

Komma igång

Öppna din VBA-editor, skapa en ny UserForm och ändra dess Egenskap till "Calendrier".

Kopiera koden nedan i modulen i UserForm:

 Alternativ Explicit Private Sub UserForm_Initialize () Dim Obj Som kontroll Dim i som heltal, Mois som heltal, Annee som helhet Dim Cl som Classe1 'Création Changement de mois' LABEL Set Collect = Ny samlingsuppsättning Obj = Me.Controls.Add ("formulär .Label.1 ") Med Obj .Name =" LbChoixMois ".Object.Caption =" Choix du mois: ".Left = 5 .Top = 5 .Width = 70 .Height = 10 slutar med" BOUTONS Set Obj = Me. Controls.Add ("forms.CommandButton.1") Med Obj .Name = "MoisPrec" .Object.Caption = "" .Left = 95 .Top = 1 .Width = 20 .Height = 20 Slut Med Set Cl = Ny Classe1 Ställ in Cl.Bouton = Obj Collect.Add Cl 'Création entête Jours de la semaine För i = 1 till 7 Ange Obj = Me.Controls.Add ("forms.Label.1") Med Obj .Name = "Jour" & i .Object.Caption = UCase (Vänster (Format (DateSerial (2014, 9, i), "dddd"), 1)) .Left = 20 * (i - 1) + 5 .Top = 25. Bredd = 20 .Höjd = 10 Avsluta med Nästa I 'Creation boutons "jours" Mois = Månad (Datum) MoisEnCours = Mois Annee = År (Datum) AnneeEnCours = Annee CreationBoutonsJours Mois, Annee Om vänster (Format, Datum, "dd"), 1) = "0" Då Me.Controls ("Bouton" & Format (Datum, "d")). SetFocus Else Me.Controls ("Bouton" & Format, "dd")). SetFocus End Sub

Skapa knapparna

Antalet dagar varierar från en månad till en annan, så vi skapar dem dynamiskt. För detta, ett förfarande som vi behöver:

Ta bort de gamla knapparna
Skapa nya knappar baserat på månad och år.

Skapa en modul (Infoga> Modul) och kopiera underkoden:

 Alternativ Explicit Public WithEvents Bouton Som MSForms.CommandButton Privat Sub Bouton_Click () Välj Case Bouton.Name Fall "MoisPrec" MoisEnCours = MoisEnCours - 1 Om MoisEnCours = 0 Då MoisEnCours = 12 AnneeEnCours = AnneeEnCours - 1 Om AnneeEnCours = 1899 Då MoisEnCours = 1 AnneeEnCours = 1900 MsgBox "Première année: 1900" Slut Om Slut Om fall "MoisSuiv" MoisEnCours = MoisEnCours + 1 Om MoisEnCours = 13 Då MoisEnCours = 1 AnneeEnCours = AnneeEnCours + 1 Slut Om Slut Välj CreationBoutonsJours MoisEnCours, AnneeEnCours End Sub

Klassmodulerna

Vi måste skapa till klassmodulen för att kommandoknapparna ska fungera.

För att navigera mellan månader:

 Alternativ Explicit Public WithEvents Btn Som MSForms.CommandButton "Procédure lors du clic sur un bouton" jour "Privat Sub Btn_Click () Dim maDate Som Datum maDate = CDate (Btn.Caption &" / "& Calendrier.Tag) 'La ligne suivante détermine Det är viktigt att du gör det möjligt för dig att hämta det här datumet. Hämta det här datumet och välj det här alternativet. Användarform: 'ActiveCell.Value = maDate' Lossa kalendrar MsgBox maDate End Sub ' du vill ha en privat del Btn_MouseMove (ByVal-knappen som heltal, ByVal Shift som heltal, ByVal X som singel, ByVal Y som singel) Dimma maDate som datum maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) Om EstJourFerie (maDate) eller Paques (Year (maDate)) = maDate Sedan Btn.ControlTipText = QuelFerie (maDate) End Sub

Klassmodulen för dagarna

 Alternativ Explicit Public WithEvents Btn Som MSForms.CommandButton "Procédure lors du clic sur un bouton" jour "Privat Sub Btn_Click () Dim maDate Som Datum maDate = CDate (Btn.Caption &" / "& Calendrier.Tag) 'La ligne suivante détermine Det är viktigt att du gör det möjligt för dig att hämta det här datumet. Hämta det här datumet och välj det här alternativet. Användarform: 'ActiveCell.Value = maDate' Lossa kalendrar MsgBox maDate End Sub ' du vill ha en privat del Btn_MouseMove (ByVal-knappen som heltal, ByVal Shift som heltal, ByVal X som singel, ByVal Y som singel) Dimma maDate som datum maDate = CDate (Btn.Caption & "/" & Calendrier.Tag) Om EstJourFerie (maDate) eller Paques (Year (maDate)) = maDate Sedan Btn.ControlTipText = QuelFerie (maDate) End Sub

Hantera helgdagar

I den standardmodul som skapats tidigare lägger vi till tre funktioner för att identifiera semestrar.

En funktion som returnerar semestern som en sträng

 "Fonction qui retourne le jour férié en" String "" Utile pour les info-bulles au survol des jours fériés Officiell funktion QuelFerie (Jour As Date) Som String Dim Mått som Date Dim en som helhet, m Som helhet, j Som helhet maDate = Paques (Year (Jour)) Om Jour = maDate Then QuelFerie = "Dimanche de Pâques": Utgångsfunktion Om Jour = CDate (maDate + 1) Då QuelFerie = "Lundi de Pâques": Utgångsfunktion Om Jour = CDate (maDate + 50) Då QuelFerie = "Lundi de Pentecôte": Utgångsfunktion Om Jour = CDate (maDate + 39) Då QuelFerie = "Jeudi de l'ascension": Utgångsfunktion a = År (Jour): m = Månad (Jour): j = Day (Jour) Välj fall m * 100 + j Fall 101 QuelFerie = "1er Janvier": Exit Function Case 501 QuelFerie = "1er Mai": Exit Function Case 508 QuelFerie = "8 Mai": Exit Function Case 714 QuelFerie = " 14 Juillet ": Exit Function Case 815 QuelFerie =" 15 Août ": Exit Function Case 1101 QuelFerie =" 1er Novembre ": Exit Function Case 1111 QuelFerie =" 11 Novembre ": Exit Function Case 1225 QuelFerie =" Noël ": Utgångsfunktion Slut Välj slutfunktion

En funktion som identifierar helgdagarna

 "KÄLLOR:" //blog.developpez.com/philben/p11458/vba-access/sagit-il-dun-jour-ferie Offentlig funktion EstJourFerie (ByVal laDate som datum, valfritt ByVal EstPentecoteFerie som booleskt = True) Som booleskt 'Détermine det är ett datum där du inte är berättigad för att du ska kunna göra det: (101) 11 Novembre - 1225 = 25 Décembre 'dPa = Lundi de Pâques - dAs = Jeudi de l'Ascension - dPe = Lundi de Pentecôte' Remarque: Det är ett litet land, som är en av de största städerna i Estland, EstepentecoteFerie = False dans ce cas) "Philben - v1.0 - 2012 - Fri att använda Static Annee som integer, dPa som datum, dAs som datum, dPe som datum, bPe Som booleskt dim a som heltal, m Som heltal, j Som heltal a = År (laDate) : m = Månad (laDate): j = Dag (laDate) Välj fall m * 100 + j Fall 101, 501, 508, 714, 815, 1101, 1111, 1225 EstJourFerie = True Case 323 Till 614 '323: Date mini Lundi de Pâques - 614: Dat E-posta om Lundi de Pentecôte Om en Annee eller EstPentecoteFerie bPe Då Annee = a: dPa = Paques (a) + 1: dAs = dPa + 38 bPe = EstPentecoteFerie: Om bPe Då dPe = dPa + 49 Else dPe = # 1/1 / 100 # Sluta om Välj fall DatumSerial (a, m, j): Fall dPa, dAs, dPe: EstJourFerie = Sant: Slut Välj Slut Välj Slut Funktion