AW: Kalenderwoche eingeben, Datum ausgeben
Holger
Hallo Fritz,
hier ein wenig Code.
Hatte bisher keine Sorgen damit.
Hoffe es hilft dir.
Gruß Holger.
'Description: Die Kalenderwoche eines Datums ermitteln
'Parameters: [datCheckDate]
'Return: Integer
'* DT03 ****************************************************
Public
Function GetGermanCalendarWeek( _
Optional ByVal datCheckDate As Date) As Integer
Dim datLastDay As Date
Dim intWeek As Integer
If datCheckDate = 0 Then datCheckDate = Date
'nach DIN1355...
intWeek = DatePart("ww", datCheckDate, vbMonday, _
vbFirstFourDays)
If intWeek = 53 And Month(datCheckDate) = 12 Then
datLastDay = CDate("12/31/" & DatePart("yyyy", datCheckDate))
If Weekday(datLastDay, vbMonday) >= 4 Then
GetGermanCalendarWeek = intWeek
Else
GetGermanCalendarWeek = 1
End If
Else
GetGermanCalendarWeek = intWeek
End If
End Function
'Description: Die Anzahl der Kalenderwochen eines Jahres ermitteln
'Parameters: intYear
'Functions: GetGermanCalendarWeek
'Return: Integer
'* DT04 ****************************************************
Public
Function CountGermanCalendarWeeks( _
ByVal intYear As Integer) As Integer
If DatePart("w", DateSerial(intYear, 1, 1), _
vbMonday) = 4 Or DatePart("w", DateSerial(intYear, _
12, 31), vbMonday) = 4 Then
CountGermanCalendarWeeks = 53
Else
CountGermanCalendarWeeks = 52
End If
End Function
'Description: Den ersten Tag einer bestimmten Kalenderwoche ermitteln
'Parameters: intWeek, intYear
'Functions: CountGermanCalendarWeeks
'Return: Date
'* DT05 ****************************************************
Public
Function GetFirstDayOfGermanCalendarWeek( _
ByVal intWeek As Integer, _
ByVal intYear As Integer) As Date
Dim datStartDate As Date
If intWeek <= CountGermanCalendarWeeks(intYear) Then
datStartDate = DateAdd("d", _
DateSerial(intYear, 1, 4), -DatePart _
("w", DateSerial(intYear, 1, 4), vbMonday) + 1)
GetFirstDayOfGermanCalendarWeek = DateAdd("ww", _
intWeek - 1, datStartDate)
End If
End Function