RSS

Userform med kalender til valg af datoer

På denne side viser jeg, hvordan man kan lave en kalender til valg af datoer ved at bruge Excel VBA makroer (eller andre Office-programmer).

Væsentligt er, at der ikke bruges ActiveX, som kan give problemer, fordi forskellige versioner af MS Office bruger forskellige ActiveX kontroller.

Sådan ser kalenderen ud i den danske version af Excel 2003:

Kalender og datovælger

I U.S.A., der bruger søndag som første dag i ugen i stedet for mandag, vil der i "dag-mærkaterne" stå (fra venstre mod højre): SU, MO, TU, WE, TH, FR og SA, og 1. februar 2016 vil stå i 2. kolonne under "MO".

Med andre ord indretter kalenderen sig efter systemindstillingerne for sprog og første dag i ugen. De mulige datoformater er også baseret på systemindstillingerne.

Man kan bruge kalenderen til at vælge (op til) to datoer til selvvalgt brug (skriv din egen kode i OK-knappens klikprocedure). De valgte datoer står i to labels til højre, og klikker man på en af dem, kan man kopiere datoen til en eller flere celler.

Jeg viser og forklarer nogle af makroerne længere nede på siden, men jeg kan ikke vise dem alle. Vil du se resten, kan du downloade et zip-komprimeret regneark med eksemplet.

Regnearket er opdateret den 26. februar 2017, da der var en fejl, som påvirkede funktionaliteten.

Kommentarerne i regnearkets VBA-kode er på engelsk - jeg orker ikke lave to versioner.

Kalenderen er på en UserForm (se billedet ovenfor) med en frame, labels, combo boxe og kommandoknapper.

Til at håndtere hændelser (events - når brugeren klikker på en dato) bruger kalenderen et simpelt klassemodul i stedet for at skrive klik-procedurer til hver eneste label.

Der bruges i sagens natur også en del datofunktioner såsom at finde ugens første dag, første dag i en måned, sprogafhængige navne på dage, tjek for skudår m.m.

Jeg er en dårlig designer, så giv kalenderen det udseende, du foretrækker; men medmindre du ændrer koden, skal labels til datovalg alle være i Frame1.

Kalenderens collections

Der er to public collections deklareret i Module1: colLabelEvent og colLabels, og kalenderens dato-labels er med i begge collections.

colLabelEvent er en collection af event-håndteringsklasserne for dato-labels, og colLabels sætter os i stand til at ændre en labels egenskaber ved fx at skrive:
colLabels.Item(variabel for labelnavn).Visible = False

Jeg vender tilbage til event-håndteringsklassen. Det lyder måske langhåret, men er ganske ukompliceret.

Kalenderens Initialize procedure

En UserForms Initialize procedure eksekveres før formularen åbner, og herunder kan du se, hvordan kalenderens ser ud.


Private Sub UserForm_Initialize()
'Denne procedure eksekverer før formularen åbner.
Dim ctl As Control               'Userform control variabel
Dim lCount As Long               'Tæller
Dim InputLblEvt As clLabelClass  'Midlertidig klasse

On Error GoTo ErrorHandle

'De to collections, colLabelEvent og colLabels
'er deklareret i Module1.
'colLabelEvent er en collection af klasser,
'clLabelClasses, som kontrollerer, hvad der sker,
'når brugeren klikker på en dato-label.
'colLabels er en collection af formularens
'dato-labels og bruges bl.a. til at sætte properties,
'fx at sætte blå ramme omkring den valgte dato.
Set colLabelEvent = New Collection
Set colLabels = New Collection

'Gennemløb dato-labels i Frame1
'og føj dem til de to collections.
For Each ctl In Frame1.Controls
   'Hvis kontrolelementet er en label
   If TypeOf ctl Is MSForms.Label Then
      'Så lav et nyt eksemplar af clLabelClass
      Set InputLblEvt = New clLabelClass
      
      'og knyt det til denne Label
      Set InputLblEvt.InputLabel = ctl
      
      'som vi føjer til colLabelEvent.
      'Ethvert klik på en dato-label i Frame1
      'vil nu blive behandlet af klassen,
      'fordi den deklarerer:
      'Public WithEvents InputLabel As MSForms.Label
      'På den måde undgår vi at skrive klik-events for
      'hver eneste label.
      colLabelEvent.Add InputLblEvt
      
      'Den føjes også til samlingen, colLabels
      colLabels.Add ctl, ctl.Name
   End If
Next

'Vi har ikke længere brug for klassen InputLblEvent
'og sætter den til Nothing for at spare hukommelse.
Set InputLblEvt = Nothing

'Tilføj månedsnavne til måneds-comboboksen.
'Ved at bruge VBA-funktionen MonthName 
'bruges automatisk det sprog, som er valgt 
'i systemindstillingen.
For lCount = 1 To 12
   With cmbMonth
      .AddItem MonthName(lCount)
   End With
Next

'Tilføj år til årstals-comboboksen. VBA håndterer
'ikke år før 1900, hvis der skal regnes o.l..
For lCount = 1900 To Year(Now) + 100
   With cmbYear
      .AddItem lCount
   End With
Next

'Ugedags-labels med lokale indstillinger (første dag
'i ugen) og sprog.
'Hvis landet fx er USA og sproget engelsk, vil den første
'dag i ugen være søndag, og fra venstre mod højre vil der
'stå flg. på mærkaterne:
'"SU" "MO" "TU" "WE" "TH" "FR" "SA"
'VBA-funktionen StrConv(String,1) konverterer til store
'bogstaver. UCase kan også bruges.
lblDay1.Caption = StrConv(Left(WeekdayName(1, , vbUseSystemDayOfWeek), 2), 1)
lblDay2.Caption = StrConv(Left(WeekdayName(2, , vbUseSystemDayOfWeek), 2), 1)
lblDay3.Caption = StrConv(Left(WeekdayName(3, , vbUseSystemDayOfWeek), 2), 1)
lblDay4.Caption = StrConv(Left(WeekdayName(4, , vbUseSystemDayOfWeek), 2), 1)
lblDay5.Caption = StrConv(Left(WeekdayName(5, , vbUseSystemDayOfWeek), 2), 1)
lblDay6.Caption = StrConv(Left(WeekdayName(6, , vbUseSystemDayOfWeek), 2), 1)
lblDay7.Caption = StrConv(Left(WeekdayName(7, , vbUseSystemDayOfWeek), 2), 1)

'Giv dato-mærkaterne en label fra 1 til 42. Tag'en bruges af clLabelClass
'til at tjekke, om en dato er i den aktive måned, forrige eller næste.
With colLabels
   For lCount = 1 To .Count
      .Item(lCount).Tag = lCount
   Next
End With

'LabelCaptions proceduren arrangerer kalenderens
'udseende på grundlag af måned og år.
LabelCaptions Month(Now), Year(Now)

'Mulige datoformater
With cmbDateFormat
   .AddItem Format(Now, "Long Date")
   .AddItem Format(Now, "Medium Date")
   .AddItem Format(Now, "Short Date")
   .Text = Format(Now, "Short Date")
End With

'Find systemindstilling for rækkefølge af dag og måned.
lDayPos = Day("01-02-03")
lMonthPos = Month("01-02-03")

Exit Sub
ErrorHandle:
MsgBox Err.Description
End Sub

Initialize-proceduren sluttede med at kalde LabelCaptions-proceduren og videregav to argumenter, nemlig den aktuelle måned og år.

LabelCaptions-proceduren laver flere ting, som afgør kalenderens udseende, og den kaldes, hver gang brugeren skifter måned eller år.

Den tjekker ting, som hvor mange dage der er i en måned, hvor månedens første dato skal placeres i henhold til første dag i ugen samt andre ting. Den ser ud som følger.


Sub LabelCaptions(lMonth As Long, lYear As Long)
Dim lCount As Long            'Tæller
Dim lNumber As Long           'Tæller
Dim lMonthPrev As Long        'Forrige måned
Dim lDaysPrev As Long         'Dage i forrige måned
Dim lYearPrev As Long         'Forrige år

'Få månedens navn baseret på månedsnummer
sMonth = MonthName(lMonth)

'Gem månedsnummeret i variabel
lSelMonth = lMonth

'Gem år i variabel
lSelYear = lYear

'Forbered at få antal dage i forrige måned
Select Case lMonth
   Case 2 To 11
      lMonthPrev = lMonth - 1
      lYearPrev = lYear
   Case 1
      lMonthPrev = 12
      lYearPrev = lYear - 1
   Case 12
      lMonthPrev = 11
      lYearPrev = lYear
End Select

'Antal dage i måned (funktionskald - se senere)
lDays = DaysInMonth(lMonth, lYear)
'Dage i forrige måned
lDaysPrev = DaysInMonth(lMonthPrev, lYearPrev)

'Hvis det er januar 1900 gøres tilbage-knappen passiv.
If lSelYear >= 1900 And lSelMonth > 1 Then
   lblBack.Enabled = True
ElseIf lSelYear = 1900 And lSelMonth = 1 Then
   lblBack.Enabled = False
End If

'Hvis kaldet af denne procedure ikke blev udløst
'af et valg i combo-boksene for måned/år.
If bCmbSel = False Then
   cmbMonth.Text = sMonth
   cmbYear.Text = lYear
End If

'Find månedens første dato.
lFirstDayInMonth = DateSerial(lSelYear, lSelMonth, 1)

'Find datoens ugedagsnummer ved at bruge systemindstillingen for
'første dag i ugen. Vi skal vide, om det er mandag osv. for at
'kunne placere månedens første dag det rigtige sted i ugen.
'Første dag i ugen kan variere fra land til land. I USA er det
'søndag, Danmark bruger mandag.
'Vi bruger vbUseSystemDayOfWeek til at fiske systemindstillingen.
lFirstDayInMonth = Weekday(lFirstDayInMonth, vbUseSystemDayOfWeek)

If lFirstDayInMonth = 1 Then
   lStartPos = 8
Else
   lStartPos = lFirstDayInMonth
End If

'Dage fra forrige måned, hvis månedens første dag ikke er mandag.
lNumber = lDaysPrev + 1
For lCount = lStartPos - 1 To 1 Step -1
   lNumber = lNumber - 1
   With colLabels.Item(lCount)
      .Caption = lNumber
      .ForeColor = &HE0E0E0
   End With
Next

'Dato-labels for den aktive/valgte måned.
lNumber = 0
For lCount = lStartPos To lDays + lStartPos - 1
   lNumber = lNumber + 1
   With colLabels.Item(lCount)
      .Caption = lNumber
      .ForeColor = &H80000012
   End With
Next

'Dato-labels for næste måned
lNumber = 0
For lCount = lDays + lStartPos To 42
   lNumber = lNumber + 1
   With colLabels.Item(lCount)
      .Caption = lNumber
      .ForeColor = &HE0E0E0
   End With
Next

End Sub

Herunder ses funktionen, som finder antal dage i måneden. Den er ganske enkel.


Function DaysInMonth(lMonth As Long, lYear As Long) As Long

'Antal dage i måneden
Select Case lMonth
   Case 1, 3, 5, 7, 8, 10, 12
      DaysInMonth = 31
   Case 2
      'Skudår?
      If IsDate("29/2/" & lYear) = False Then
         DaysInMonth = 28
      Else
         DaysInMonth = 29
      End If
   Case Else
      DaysInMonth = 30
End Select

End Function

Der er flere procedurer til at håndtere brugerhandlinger som fx skift af måned og år med comboxene. Det er nødvendigt, men lidt trivielt, og du kan se al koden, hvis du downloader regnearket.

Den vigtigste ting tilbage er klassen, som håndterer, hvad der skal ske, når der klikkes på en af vores dato-labels.

Klassen som håndterer hændelser

I formularens Initialize-procedure koblede vi alle dato-labels til klassen clLabelClass og føjede dem til en collection, colLabelEvent.

Brugeren vælger en dato ved at klikke på en dato-label, og hvis man ikke havde klassen til at håndtere denne hændelse, skulle man skrive en klik-procedure for hver eneste label. Nu klarer vi alle klik med én procedure i klassemodulet nedenunder.

Koden bruger nogle public variable som fx sActiveDay deklareret i Module1.


Option Explicit

'Ved at deklarere Public WithEvents kan vi håndtere
'hændelser "kollektivt". I dette tilfælde er det klik
'på en dato-label, og ved at gøre det på denne måde
'undgår vi at skulle skrive klik-procedurer for hver
'eneste dato-label.
Public WithEvents InputLabel As MSForms.Label
Private Sub InputLabel_click()

'Den valgte dag skifter udseende
With InputLabel
   'Hvis forrige måned
   If .Tag < lStartPos Then
      If UserForm1.lblBack.Enabled = True Then
         UserForm1.lblBack_Click
      End If
      Exit Sub
   End If
   If .Tag > lDays + lStartPos - 1 Then
      UserForm1.lblForward_Click
      Exit Sub
   End If
   'Hvis allerede valgt, hopper vi ud
   If .BorderColor = vbBlue Then Exit Sub
   
   .BorderColor = vbBlue
   .BorderStyle = fmBorderStyleSingle

   'Hvis en anden dag var valgt før denne,
   'får den "normalt" udseende - altså den blå
   'ramme fjernes.
   If Len(sActiveDay) > 0 Then
      If sActiveDay <> InputLabel.Name Then
         With colLabels.Item(sActiveDay)
            .BorderColor = &H8000000E
            .BorderStyle = fmBorderStyleNone
         End With
      End If
   End If
   sActiveDay = InputLabel.Name
   lFirstDay = Val(InputLabel.Caption)
   
   'Hvis dato nummer 2 ikke er valgt
   If bSecondDate = False Then
      UserForm1.FillFirstDay
   Else
      'Hvis det er dato nummer 2
      UserForm1.FillSecondDay
   End If
End With

End Sub

Det var det vigtigste af kalenderens VBA-kode. For at se resten kan du downloade regnearket.

Den/de valgte datoer vil stå i to labels til højre, men internt gemmes de i variablerne datFirstDay og datLastDay (deklareret på modulniveau i userformen).

Datoer kan bruges på mange måder, og du kan skrive din egen kode i OK-knappens klik-procedure.

Som eksempel finder jeg forskellen mellem de to datoer i dage og viser den i en messagebox. Den kode kan du bare erstatte med din egen.

Ved at vælge min fødselsdag, mens jeg skriver dette, kan jeg se, at jeg har levet i 21.979 dage. Som tiden dog flyver ...

Relateret: