Hoe zet ik de datum op de huidige dag met ingevoegde procedure?

[VBA1]

Hallo allemaal,

Ik gebruik de volgende functie en sub om mijn programma te laten weten of het een even of oneven week is,
Maar bij het testen blijkt dat ie de datum op 01-01-1900 zet. Graag zou ik willen dat ie de datum op vandaag zet
en berekent of het een even of oneven week is. Ik heb het geprobeerd met de volgende code:

Public Sub EvenOnevenWeek()
        
        Dim ValueIsEven As Date
       

           'Use the IsEven function to determine whether or not the number
           'being tested is even: a return value of False means the number
           'is odd. You could alternatively use the IsOdd function.
           ValueIsEven = IsoWeekNumber(ValueIsEven)

           'If ValueIsEven is true, then...
           If ValueIsEven Mod 2 = 0 Then

               '...display a message box stating so.
               Let frmWeek.lblWk2.Caption = "even"

           'Otherwise...
           Else

               '...display a message box stating that the value is odd.
               Let frmWeek.lblWk2.Caption = "oneven"
           End If

       
   End Sub

Public Function IsoWeekNumber(d1 As Date) As Integer

   'Attributed to Daniel Maher
   Dim d2 As Long
   d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
   IsoWeekNumber = Int((d1 - d2 + Weekday(d2) + 5) / 7)

End Function

Iemand een suggestie wat ik moet aanpassen, of een beter idee?

Alvast bedankt!

 

[edmoor]

Door de bijbehorende functie als volgt te gebruiken:

If IsoWeekNumber(Date()) Mod 2 = 0

 

[VBA1]

Heel erg bedankt, edmoor!