In dieser Rubrik liefern wir Ihnen in jeder Ausgabe von Access im Unternehmen einige interessante VBA-Funktionen, mit denen Sie den Funktionsumfang von VBA erweitern können.
Montag und Sonntag ermitteln
Einige Anwendungsfälle benötigen das Datum eines Montags oder Sonntags für eine Kalenderwoche oder ein gegebenes Datum. Die beiden Routinen aus Listing 1 und Listing 2 erledigen Letzteres: Sowohl MontagErmitteln als auch SonntagErmitteln erwarten ein Datum als Parameter, zu dem die Routine dann den vorherigen Montag oder den folgenden Sonntag berechnet. Ein Einsatzfall ist etwa der Monatskalender in Berichtsform aus [1].
Listing 1: Montag einer Woche zu einem gegebenen Datum ermitteln
Public Function MontagErmitteln(dateReferenzdatum As Date) As Date Dim dateTemp As Date dateTemp = dateAusgangsdatum Select Case Weekday(dateTemp) Case Is > 2 MontagErmitteln = _
DateAdd("d", dateTemp, -Weekday(dateTemp) + 2) Case 2 MontagErmitteln = dateTemp Case 1 MontagErmitteln = DateAdd("d", dateTemp, -6) End Select End Function
Listing 2: Sonntag einer Woche zu einem gegebenen Datum ermitteln
Public Function SonntagErmitteln(dateReferenzdatum As Date) As Date Dim dateTemp As Date dateTemp = dateAusgangsdatum Select Case Weekday(dateTemp) Case 1 SonntagErmitteln = dateTemp Case Is > 1 SonntagErmitteln = DateAdd("d", dateTemp, 8 - Weekday(dateTemp)) End Select End Function
Kalenderwoche ermitteln
Ebenfalls in [1] wird die Funktion Kalenderwoche benötigt, die zu einem Referenzdatum die passende Kalenderwoche ermittelt (s. Listing 3). Die Funktion setzt voraus, dass die erste Woche diejenige ist, die vier Tage des neuen Jahres enthält. Der übergabeparameter ist vom Typ Date, der Rückgabewert ist eine Integer-Zahl.
Listing 3: Kalenderwoche zu einem Datum ermitteln
Function Kalenderwoche(dateReferenzdatum As Date) _
As Integer Kalenderwoche = _
Format(dateReferenzdatum, "ww", vbMonday, _
vbFirstFourDays) If Kalenderwoche > 52 Then If Format(dateReferenzdatum + 7, _
"ww", vbMonday, vbFirstFourDays) = 2 Then Kalenderwoche = 1 End If End If End Function