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
|