Funktionen zur Kalenderwoche
[Windows 95/98/NT/2000]

23.04.2001


Berechnen Sie die Kalenderwoche aus einem Datum,
    oder aber aus gegebener Kalenderwoche und der Jahreszahl
    den Tag, an dem diese Woche beginnt:
    

ERFORDERLICHE OBJEKTE      
   2 CommandButtons (Command1, Command2)
 FORM-CODE   
   Private 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
   Private Function Datum_aus_Woche(Jahr As Integer, Woche As Integer)
      Dim intTag As Integer, 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
   Private Sub Command1_Click()
      Dim Datum As Date
      Datum = Format(Now, "dd.mm.yyyy")
      MsgBox "Aktuelle Kalenderwoche: " & KalenderWoche(Datum)
   End Sub
   Private Sub Command2_Click()
      Dim KW As Integer
      Dim Jahr As Integer
      KW = KalenderWoche(Format(Now, "dd.mm.yyyy"))
      Jahr = Format(Now, "yyyy")
      MsgBox "Die Woche " & KW & " im Jahre " & Jahr & _
         " beginnt am: " & Datum_aus_Woche(Jahr, KW)
   End Sub