' ermittelt aus einem Datum die Kalenderwoche
Public Function kw(ByVal d As Date)
Dim t As Long
    t = DateSerial(Year(d + (8 - WeekDay(d)) Mod 7 - 3), 1, 1)
    kw = ((d - t - 3 + (WeekDay(t) + 1) Mod 7)) \ 7 + 1
End Function
 
' ermittelt aus einem Datum die Kalenderwoche
Public Function KWab(ByVal Woche As Byte, Optional Jahr As Long = 1, Optional _
  Tag As Byte = 1) As Date
Dim dat As Date
Dim dif As Long
    If Jahr = 1 Then Jahr = Year(now())
    dat = DateSerial(Jahr, 6, 1)
    Do Until WeekDay(dat) = 2
        dat = dat + 1
    Loop
    dif = Woche - kw(dat)
    KWab = dat + dif * 7 + Tag - 1
End Function