Beste Oplosser,
Ik loop tegen het probleem met onderstaande functie.
Case en bevindingen:
Bedoeling is om in kalender de vrije dagen van de kerstvakantie weer te geven.
In het tekstvak(datumveld) komt Kerstvakantie te staan.
Het loopt mis als je in de kalender naar januari gaat.
Dan genereerd de functie de schoolvakantiedagen voor volgend Kerstperiode en kan niet de bedoeling zijn.
De bedoeling is dan dat de resterende kerstvakantiedagen die in de maand januari valt ook te tonen in het tekstvak(datumveld).
De start van de Kerstvakantie is variabele datum. Hij geeft de datum weer wanneer de kerstvakantie begint.
Heb hele nacht geprobeerd om het opgelost te krijgen maar het lukt mij niet.
Ik vraag naar jullie bedreven expertise om mee te vinden/zoeken naar een oplossing.
Public Function Iskerstvakantie(jaar As Integer) As Date
'Auteur: Diezel
'e-mail:
'Datum: Dinsdag 12 januari 2021
'Object: modFunctie ? strHolKerVak(#12/22/2020#)
'Doel: Genereer een geldige datum voor start van de kerstvakantie!
'Commentaar: De kerstvakantie begint de maandag van de week waarin Kerstdag valt en duurt 2 weken;
'Indien Kerstdag op een zaterdag of zondag valt, dan begint de kerstvakantie op de maandag na Kerstdag.
'http://www.wettelijke-feestdagen.be/wettelijke-feestdagen-belgie-2015.aspx
'de kerstvakantie begint de maandag van de week waarin refKerstvakantievalt en duurt 2 weken.
'Indien refKerstvakantieop een zaterdag of zondag valt, dan begint de kerstvakantie op de maandag na Kerstdag;
Dim result As Date
Dim refKerstvakantie As Date
refKerstvakantie = DateSerial(Jaar, 12, 25)
'De kerstvakantie begint de maandag van de week waarin refKerstvakantie valt.
'Valt refKerstvakantie op een zaterdag of zondag dan start de kerstvakantie op de maandag na kerstdag.
Select Case Weekday(refKerstvakantie)
Case 7
'Zaterdag
Iskerstvakantie = refKerstvakantie + 2
Case 6
'Vrijdag
Iskerstvakantie = refKerstvakantie - 4
Case 5
'Donderdag
Iskerstvakantie = refKerstvakantie - 3
Case 4
'Woensdag
Iskerstvakantie = refKerstvakantie - 2
Case 3
'Dinsdag
Iskerstvakantie = refKerstvakantie - 1
Case 2
'Maandag
Iskerstvakantie = refKerstvakantie
Case 1
'Zondag
Iskerstvakantie = refKerstvakantie + 1
End Select
End Function
Public Function strHolKerVak(ByVal dtmDate As Date) As String
Dim HolidaysKerstVakantie(0 To 13) As Date
Dim refKerstvakantie As Date
Dim Holidays As Integer
Dim dtmStr As String
'We vragen begin van de Kerstvakantie op rekinghoudend wanneer de 25 december valt in de week of weekend
refKerstvakantie = Iskerstvakantie(Year(dtmDate))
'We steken de vrije dagen van het kerstverlof in de array HolidaysKerstvakantie
For Holidays = 0 To 13 Step 1
'We tellen de vrije Kerstvakantiedagen op(14d)
HolidaysKerstVakantie(Holidays) = CDate(refKerstvakantie) + Holidays
'Print in venster direct de kerstvakantiedagen af
'Debug.Print HolidaysKerstVakantie(Holidays)
Next Holidays
For Holidays = 0 To 13 Step 1
'Indien dtmDate overeenkomt met een Holidaydatum uit de array,
'dan krijgt dtmStr "Kerstvakantie"
If HolidaysKerstVakantie(Holidays) = dtmDate Then
dtmStr = "Kerstvakantie"
Exit For
End If
Next Holidays
strHolKerVak = dtmStr
End Function
Kalender met module komt in bijlage zodat je het visueel het resultaat van het probleem kan zien.
Klik op dec en januari om het probleem te zien.
Vriendelijke groet,
Diezel