[VB6] Kaufmännische Datumsangaben

Public Function KalenderWoche(Datum As Date) As Integer
Dim tmp As Double
 
   tmp = DateSerial(Year(Datum + (8 - Weekday(Datum)) Mod 7 - 3), 1, 1)
   KalenderWoche = (Datum - tmp - 3 + (Weekday(tmp) + 1) Mod 7) \ 7 + 1
 
End Function
 
Public Function Datum_aus_Woche(Jahr As Integer, _
                                Woche As Integer)
Dim intTag As Integer
Dim intWoche As Integer
   
   If Jahr = 0 Then
      Datum_aus_Woche = 0
      Exit Function
   End If
   
   intTag = 1
   intWoche = KalenderWoche(DateSerial(Jahr, 1, 1))
   
   If intWoche <> 1 Then
      Do Until KalenderWoche(DateSerial(Jahr, 1, intTag)) = 1
         intTag = intTag + 1
      Loop
   Else
      Do Until KalenderWoche(DateSerial(Jahr, 1, intTag)) <> 1
         intTag = intTag - 1
      Loop
      intTag = intTag + 1
   End If
   
   Datum_aus_Woche = DateSerial(Jahr, 1, intTag) + (Woche - 1) * 7
 
End Function