Formulier reeds invullen afhankelijk van datum

[ame225]

Beste,

Ik heb een klein formuliertje gemaakt waarbij ik bepaalde gegevens wil afdrukken.
De gegevens die moeten afgedrukt worden, zijn afhankelijk van de dag waarop ze afgedrukt worden.

Bv. Ik heb een zomermenu en een wintermenu (zomermenu loopt van 18/03/2016 - 16/10/2016 en de wintermenu van 17/10/2016 - 19/03/2017)

Nu had ik graag in mijn tekstbox bij seizoen gehad dat daar automatisch "zomer" staat wanneer de datum tussen 18/03/2016 en 16/10/2016 ligt en "winter" wanneer de datum tussen 17/10/2016 en 19/03/2017 ligt

Onder seizoen staat week: Iedere seizoensmenu bevat 5 weekmenu's die telkens na elkaar komen. Zo komt week 1 voor in de week van 21/03/2016 - 27/03/2016, in de week van 25/04/2016 - 01/05/2016, ...

Het zou leuk zijn mocht, in dit geval, week 1 automatisch in de textbox staan wanneer de datum in deze week voorkomt.

Ook bij de textbox dag: zou ik graag maandag zien staan wanneer de datum op een maandag valt.

Ik hoop dat iemand mij kan helpen.

Vriendelijke groeten

Bekijk bijlage test_Formulier.xlsm

 

[pasan]

Kun je hier wat mee?

Private Sub cmd_Sluiten_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
txt_Datum.Text = Format(Now, "dd/mm/yyyy")
txt_Seizoen = Seizoen(Date)
txt_Week = SHIFT(Date)
txt_Dag = Format(Now, "dddd")
End Sub

Public Function ISOweeknum(ByVal Datum As Date) As Integer
ISOweeknum = DatePart("ww", Datum - Weekday(Datum, 2) + 4, 2, 2)
'**** http://www.snb-vba.eu/
End Function


Public Function Seizoen(Datum As Date) As String
Seizoen = IIf(Datum >= DateSerial(Year(Datum), 3, 18) And Datum <= DateSerial(Year(Datum), 10, 16), "Zomer", "Winter")
End Function


Public Function SHIFT(Datum As Date)

Dim Rooster() As Variant

Rooster = Array("1", "1", "1", "1", "1", "1", "1", "2", "2", "2", "2", "2", "2", "2", "3", "3", "3", "3", "3", "3", "3", "4", "4", "4", "4", "4", "4", "4", "5", "5", "5", "5", "5", "5", "5")
ReferentieDatum = "18/03/2016"

NummerInArray = DateDiff("d", ReferentieDatum, Datum) Mod (UBound(Rooster) + 1)
If NummerInArray < 0 Then NummerInArray = NummerInArray + UBound(Rooster) + 1

SHIFT = Rooster(NummerInArray)

'*** Functie door Gert Spapen, 2009
'*** http://www.shiftkalender.be

End Function

Test deze wel, je begint de Zomer telling op een vrijdag en de Winter telling op een maandag.
Kun je ze niet allebei op een zelfde dag laten beginnen? of serveer je alleen menu's op maandag tot vrijdag en nooit in het weekend?

 

[ame225]

Beste,

Bedankt voor je antwoord.
Heb je die code toevallig ook in mijn voorbeeld bestand geplaatst?

Ik ben inderdaad gemist. De zomertelling moet starten op maandag 21/03/2016 en de wintertelling op maandag 17/03/2016...

 

[pasan]

De zomertelling moet starten op maandag 21/03/2016 en de wintertelling op maandag 17/03/2016.

En wanneer begint de zomer in 2017 ---> 2018 enz ???
21/03/2017 is een dinsdag
ik denk dat je beter kunt uitgaan van bijv de 3e maandag van Maart start Zomer en de 3e maandag van Oktober start winter. (maar wie ben ik)

Denk hier eerst even goed over na, laat maar weten welke datums je wil gebruiken dan zal ik het in jou bestand verwerken en hier plaatsen

 

[pasan]

Test dit bestand maar eens.
ik heb ervoor gekozen om de 3e maandag van maand Maart en Oktober te nemen om de seizoen te wisselen van Zomen / Winter.
Je geeft aan dat je steeds 5 weken wil tellen en dan weer bij 1 wilt beginnen.
In jou Zomer zitten nu 30 weken en in jou Winter zitten nu 22 weken dit past dus niet helemaal met het getal 5.
De referentie datum in de "SHIFT Function" is daarom ook de 3e maandag van maart dus elk jaar zal deze start datum vanzelf aangepast worden zodat van hieruit begonnen word met week nummer 1.
Het kan dus gebeuren dat jou weeknummer van 31-12-2016 anders is dan 1-1-2017 ik heb dit niet getest maar ongetwijfeld zal er rond een jaarwisseling de telling niet kloppen, maar hey dan blijf je de laatste week van het oude jaar lekker dicht. :thumb:

Private Sub cmd_Sluiten_Click()
Unload Me
End Sub

Private Sub UserForm_Initialize()
txt_Datum.Text = Format(Now, "dd/mm/yyyy")
''Seizoen gebruikt de 3e maandag van maart als start Zomer en de 3e maandag van Oktober als start Winter.
txt_Seizoen = IIf(CDate(txt_Datum) >= DateSerial(Year(Date), 3, 1 + 7 * 3) - Weekday(DateSerial(Year(Date), 3, 8 - 2)) And CDate(txt_Datum) < DateSerial(Year(Date), 10, 1 + 7 * 3) - Weekday(DateSerial(Year(Date), 10, 8 - 2)), "Zomer", "Winter")
txt_Week = SHIFT(CDate(txt_Datum))
txt_Dag = Format(CDate(txt_Datum), "dddd")
End Sub

Public Function SHIFT(Datum As Date)

Dim Rooster() As Variant

Rooster = Array("1", "1", "1", "1", "1", "1", "1", "2", "2", "2", "2", "2", "2", "2", "3", "3", "3", "3", "3", "3", "3", "4", "4", "4", "4", "4", "4", "4", "5", "5", "5", "5", "5", "5", "5")
ReferentieDatum = DateSerial(Year(Date), 3, 1 + 7 * 3) - Weekday(DateSerial(Year(Date), 3, 8 - 2)) '' de 3e maandag van maart

NummerInArray = DateDiff("d", ReferentieDatum, Datum) Mod (UBound(Rooster) + 1)
If NummerInArray < 0 Then NummerInArray = NummerInArray + UBound(Rooster) + 1

SHIFT = Rooster(NummerInArray)

'*** Functie door Gert Spapen, 2009
'*** http://www.shiftkalender.be

End Function

 

[ame225]

Dit ziet er zeer goed uit.
Het is helaas voor een ziekenhuis, dus sluiten is geen oplossing :d
Maar dit kan ik alleszins al heel goed gebruiken.
Het probleem is dat de zomer en wintermenu niet elk jaar op een vast moment start. Dit wordt ieder jaar opnieuw beslist.

Maar voor dit jaar kan ik al verder hé!

Heel erg bedankt!

 

[pasan]

je kunt er ook voor kiezen om deze datums in het werkblad in te vullen dan zijn ze voor elk jaar zelf eenvoudig aan te passen.
In de vba gebruik je dan deze 2 cellen, de start datum van de zomer en de eind datum van de zomer.