jaar kalender

[pasan]

op een userform heb ik een aantal labels geplaatst om alle maanden weer te geven en alle dagen in een jaar
met de volgende code probeer ik dit te realiseren
het gaat goed zolang het schrikkeljaar in beeld is (er zijn 366 labels voor dag notaties)
als er dus geen schrikkeljaar gekozen wordt, wordt 29 februarie dus 1 maart en wat 1 maart zou moeten zijn is dan 2 maart en zo door voor de rest van de kalender

hoe lost ik dit probleem op van wel of niet schrikkeljaar Bekijk bijlage kalender1.xlsm

Private Sub UserForm_Initialize()
Dim i As Integer
Dim mydate As Date
mydate = Date
   [COLOR="#FF0000"] 'lbldatum is onzichtbaar maar nodig ivm de format die ik nodig bleek te hebben om _
       de andere controls te voorzien van de juiste datum notaties[/COLOR]
    LblDatum.Caption = mydate
    nieuw
    
End Sub

Private Sub nieuw()
Dim i As Integer

[COLOR="#FF0000"]'lbldatum2 geeft het jaartal weer van de datum in lbldatum[/COLOR]
lblDatum2 = Year(LblDatum.Caption)
[COLOR="#FF0000"]'vul de maand labels 1 tot 12 met de bijbehorende maand[/COLOR]
For i = 1 To 12
   Me("Lblmaand" & i) = Format(DateSerial(Year(LblDatum.Caption), i, 1), " mmmm ")
 Next
 
 [COLOR="#FF0000"]'vul de eerste 60 labels met de dag notatie, label 60 is hierbij de 29e dag van februarie in geval van een schrikkeljaar[/COLOR]
  For i = 1 To 60
Me("label" & i) = Format(DateSerial(Year(LblDatum.Caption), 1, i), "dd")
Next

[COLOR="#FF0000"]'vul alle opvolgende labels met de dag notatie van het rest van het jaar[/COLOR]
For i = 61 To 366
Me("label" & i) = Format(DateSerial(Year(LblDatum.Caption), 1, i), "dd")
Next

End Sub

Private Sub knop_vorig_Click()
 
   LblDatum.Caption = DateAdd("yyyy", -1, LblDatum.Caption)
    nieuw

End Sub

Private Sub knop_volgend_Click()
   LblDatum.Caption = DateAdd("yyyy", 1, LblDatum.Caption)
    nieuw
End Sub

 

[snb]

zie de bijlage.

 

[pasan]

zal me hier in verdiepen (mocht ik dit allemaal snappen) en proberen of ik hiermee mn jaarkalender werkend kan krijgen
voorlopig hoef ik me niet te vervelen

Dankjewel:thumb:

 

[pasan]

met de volgende code heb ik het werkend gekregen (volgens mij) met de schrikkeljaren
deze kalender wilde ik niet gebruiken om een datum in een worksheet cel te krijgen maar om een werk rooster weer te geven met behulp van kleuren, daar kom ik nog op terug :d Bekijk bijlage kalender4.xlsm

nieuwe bijlage bij gedaan, als ik het goed gedaan heb dan werkt het nu ook bij de jaartallen 1900 2100 qua schrikkeljaar

Private Sub nieuw()
Dim i As Integer



'lbldatum2 geeft het jaartal weer van de datum in lbldatum
lblDatum2 = Year(LblDatum.Caption)

'vul de maand labels 1 tot 12 met de bijbehorende maand, de format heb ik nodig om de labels 1 tot 366 goed te krijgen_
 'deze labels zijn ontzichtbaar omdat ik alleen de maand in beeld wil hebben dat gebeurd in de volgende stap
For i = 1 To 12
   Me("Lblmaand" & i) = Format(DateSerial(Year(LblDatum.Caption), i, 1), "dd/mmmm/yy")
   Me("Lblmaand" & i).Visible = False
 Next
 
 'nu 12 labels om de maand weer tegeven op het formulier
For i = 1 To 12
   Me("maand" & i) = Format(DateSerial(Year(LblDatum.Caption), i, 1), "mmmm")
 Next
 
 If lblDatum2 Mod 100 = 0 Then
      For i = 1 To 60
         Me("label" & i) = Format(DateSerial(Year(LblDatum.Caption), 1, i), "ddd dd")
         Me("label" & i).ControlTipText = "week nr.  " & Format(DateSerial(Year(LblDatum.Caption), 1, i), "ww  dddd d mmmm yyyy")
      Next
        Label60.Visible = False
      For i = 61 To 366
        Me("label" & i) = Format(DateSerial(Year(Lblmaand3.Caption), 1, i), "ddd dd")
        Me("label" & i).ControlTipText = "week nr.  " & Format(DateSerial(Year(LblDatum.Caption), 1, i - 1), "ww  dddd d mmmm yyyy")
      Next
      
 Else

If lblDatum2 Mod 4 = 0 Or lblDatum2 Mod 400 = 0 Then
        Label60.Visible = True
      For i = 1 To 366
          Me("label" & i) = Format(DateSerial(Year(LblDatum.Caption), 1, i), "ddd dd")
          Me("label" & i).ControlTipText = "week nr.  " & Format(DateSerial(Year(LblDatum.Caption), 1, i), "ww  dddd d mmmm yyyy")
      Next

 Else
 
      For i = 1 To 60
         Me("label" & i) = Format(DateSerial(Year(LblDatum.Caption), 1, i), "ddd dd")
         Me("label" & i).ControlTipText = "week nr.  " & Format(DateSerial(Year(LblDatum.Caption), 1, i), "ww  dddd d mmmm yyyy")
      Next
        Label60.Visible = False
      For i = 61 To 366
        Me("label" & i) = Format(DateSerial(Year(Lblmaand3.Caption), 1, i - 1), "ddd dd")
        Me("label" & i).ControlTipText = "week nr.  " & Format(DateSerial(Year(LblDatum.Caption), 1, i - 1), "ww  dddd d mmmm yyyy")
      Next
  
End If
End If

End Sub

 

[Interface]

Ik heb het al een keer gepost..

Weet niet of je er wat aan hebt, maar heb een een keer een non active x datepicker gepost met een class...Bekijk bijlage MyDatePickerNoneActiveX.xls

 

[pasan]

Dank je wel voor het voorbeeld heb al het een en ander geprobeerd maar helaas ik kom er nog niet uit
wordt vervolgd

 

[pasan]

wegens tijd gebrek zet ik deze vraag op opgelost