title image


Smiley Re: Kalender einmal anders????
Für den Einstieg: erstelle ein Modul und füge dort die beiden Funktionen unten ein: Den Inhalt der ersten "Zeile" (in Access: Datensätze) erzeugt die Funktion GetTheDates(), ohne Parameter liefert sie die Daten für das aktuelle Kalendrjahr.



Gruß

Robert



Function GetTheDates(Optional lYear As Long = -1) As String

Dim d As Date

Dim r(11) As Long, l As Long

Dim sOut As String



r(0) = 0 '1. Woche, Mo: + 0

r(1) = 2 '1. Woche, Mi: + 2

r(2) = 6 '1. Woche, So: + 6

r(3) = 8 '2. Woche, Di: + 8

r(4) = 10

r(5) = 12

r(6) = 14

r(7) = 15

r(8) = 16

r(9) = 17

r(10) = 18



If lYear = -1 Then lYear = Year(Date)



d = Fkt_KWMon(1, lYear)

l = 0

Do

d = DateAdd("d", r(l), d)

sOut = sOut & ", " & Format(d, "dd.mm.")

l = l + 1

If l > UBound(r) Then l = 0

Loop While Year(d) <= lYear





GetTheDates = Mid(sOut, 3)



End Function





Public Function Fkt_KWMon(ArgKW As Byte, Optional ArgJahr)

' gibt den Montag der übergebenen KW zurück

' von Karl Donaubauer

Dim M As Date

If IsMissing(ArgJahr) Then ArgJahr = Year(Date)

M = DateSerial(ArgJahr, 1, 1) + (ArgKW - 1) * 7

M = M + 1 - Weekday(M, 2)

If Format(M, "ww", 2, 2) ArgKW Then M = M + 7

If (ArgKW = 1 Or ArgKW = 53) And Day(M) > 4 And Day(M) < 8 Then M = M - 7

Fkt_KWMon = M

End Function



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: