• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Kalender

Status
Niet open voor verdere reacties.
D

don42

Gebruiker
Lid geworden
25 apr 2014
Berichten
800
Beste allemaal,

Ik heb hier op het forum een Calender gevonden (userform)
die graag wil gaan gebruiken
er zit 1 klein vevelend dingetje in:
nl als je via de pijltjes naar een volgende maand wil
moet je eerst op het linker pijltje klikken dan pas kan je via het rechter pijlje een maand ophogen
precies het zelfde voor jaartallen werkt wel

ik hoop dat het een beetje te begrijpen is wat ik vraag
Code: 
Private Sub SB_Month_Change()
    'If CB_Mth.ListIndex > 0 And CB_Mth.ListIndex < 11 Then CB_Mth.ListIndex = CB_Mth.ListIndex + SB_Month.Value
    'If CB_Mth.ListIndex = 0 And SB_Month.Value = 1 Or CB_Mth.ListIndex = 11 And SB_Month.Value = -1 Then CB_Mth.ListIndex = CB_Mth.ListIndex + SB_Month.Value
    CB_Yr.ListIndex = CB_Yr.ListIndex + (SB_Month.Value * (((CB_Mth.ListIndex + SB_Month.Value + 1) Mod 13) = 0) * (CB_Yr.ListIndex Mod 40 <> 0))
    CB_Mth.ListIndex = (CB_Mth.ListIndex + SB_Month.Value + 12) Mod 12
    SB_Month.Value = 0
End Sub

en hier de hele code van de kalender
Code: 
Option Explicit
    Dim ThisDay As Date
    Dim ThisYear, ThisMth, ThisButton
    Dim CreateCal As Boolean
    Dim i As Integer

Private Sub Label2_Click()

End Sub

Private Sub UserForm_Initialize()
    Application.EnableEvents = False
    ThisDay = Date
    ThisMth = Format(ThisDay, "mm")
    ThisYear = Format(ThisDay, "yyyy")
    CB_Mth.Clear
    For i = 1 To 12
        CB_Mth.AddItem Format(DateValue(ThisYear & "-" & CStr(i) & "-01"), "mmmm")
    Next
    CB_Mth.ListIndex = (ThisMth) - 1
    For i = -20 To 20
        If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
            Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
    Next
    CB_Yr.ListIndex = 21
    CreateCal = True
    ThisButton = ThisDay
    Call Build_Calendar
    Application.EnableEvents = True
End Sub

Private Sub CB_Today_Click()
    ThisButton = Format(Date, "m/d/yy")
    CB_Mth.Value = Format(Date, "mmmm")
    CB_Yr.Value = Format(Date, "yyyy")
End Sub
Private Sub SB_Month_Change()
    'If CB_Mth.ListIndex > 0 And CB_Mth.ListIndex < 11 Then CB_Mth.ListIndex = CB_Mth.ListIndex + SB_Month.Value
    'If CB_Mth.ListIndex = 0 And SB_Month.Value = 1 Or CB_Mth.ListIndex = 11 And SB_Month.Value = -1 Then CB_Mth.ListIndex = CB_Mth.ListIndex + SB_Month.Value
    CB_Yr.ListIndex = CB_Yr.ListIndex + (SB_Month.Value * (((CB_Mth.ListIndex + SB_Month.Value + 1) Mod 13) = 0) * (CB_Yr.ListIndex Mod 40 <> 0))
    CB_Mth.ListIndex = (CB_Mth.ListIndex + SB_Month.Value + 12) Mod 12
    SB_Month.Value = 0
End Sub
Private Sub SB_Year_Change()
    If CB_Yr.ListIndex > 0 And CB_Yr.ListIndex < 39 Then CB_Yr.ListIndex = CB_Yr.ListIndex + SB_Year.Value
    If CB_Yr.ListIndex = 0 And SB_Year.Value = 1 Or CB_Yr.ListIndex = 39 And SB_Year.Value = -1 Then CB_Yr.ListIndex = CB_Yr.ListIndex + SB_Year.Value
    SB_Year.Value = 0
End Sub
Private Sub CB_Mth_Change()
    Build_Calendar
End Sub
Private Sub CB_Yr_Change()
    Build_Calendar
End Sub
Private Sub Build_Calendar()
    If CreateCal = True Then
    CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
    CommandButton1.SetFocus
    For i = 1 To 42
        If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
            Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
            Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
        ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
            Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
                & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
            Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
        End If
        If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
        ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
            If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018  '&H80000010
            Controls("D" & (i)).Font.Bold = True
        If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisButton, "m/d/yy") Then Controls("D" & (i)).SetFocus
        Else
            If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
            Controls("D" & (i)).Font.Bold = False
        End If
    Next
    End If
End Sub

Private Sub ChkDate()
'Cblundell changed below Greater/Less than signs. Original= "If Format(ThisButton, "m") - 1 <> CB_Mth......"
'NEW= "If Format(ThisButton, "m") - 1 = CB_Mth......"     so that when selecting dates calendar didnt
'jump months when a day between 1 & 12 was selected (as you would select the 12/06/05 (in dd/mm/yy format)
'and it would swap to december as display month)
    If Format(ThisButton, "m") - 1 = CB_Mth.ListIndex Then CB_Mth.ListIndex = Format(ThisButton, "m") - 1
' gh added next line
    CB_Yr = Year(ThisButton)

End Sub
'focus
Private Sub D1_Click()
    ThisButton = D1.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D2_Click()
    ThisButton = D2.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D3_Click()
    ThisButton = D3.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
   End Sub
Private Sub D4_Click()
     ThisButton = D4.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D5_Click()
     ThisButton = D5.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D6_Click()
     ThisButton = D6.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D7_Click()
     ThisButton = D7.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D8_Click()
     ThisButton = D8.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D9_Click()
     ThisButton = D9.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D10_Click()
     ThisButton = D10.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D11_Click()
    ThisButton = D11.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D12_Click()
    ThisButton = D12.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D13_Click()
    ThisButton = D13.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D14_Click()
    ThisButton = D14.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D15_Click()
    ThisButton = D15.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D16_Click()
    ThisButton = D16.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D17_Click()
    ThisButton = D17.ControlTipText
    ChkDate
     ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D18_Click()
    ThisButton = D18.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D19_Click()
    ThisButton = D19.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D20_Click()
    ThisButton = D20.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D21_Click()
    ThisButton = D21.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D22_Click()
    ThisButton = D22.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D23_Click()
    ThisButton = D23.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D24_Click()
    ThisButton = D24.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D25_Click()
    ThisButton = D25.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D26_Click()
    ThisButton = D26.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D27_Click()
    ThisButton = D27.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D28_Click()
    ThisButton = D28.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D29_Click()
    ThisButton = D29.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D30_Click()
    ThisButton = D30.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D31_Click()
    ThisButton = D31.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D32_Click()
    ThisButton = D32.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D33_Click()
    ThisButton = D33.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D34_Click()
    ThisButton = D34.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D35_Click()
    ThisButton = D35.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D36_Click()
    ThisButton = D36.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D37_Click()
    ThisButton = D37.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D38_Click()
    ThisButton = D38.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D39_Click()
    ThisButton = D39.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D40_Click()
    ThisButton = D40.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D41_Click()
    ThisButton = D41.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub
Private Sub D42_Click()
    ThisButton = D42.ControlTipText
    ChkDate
    ActiveCell = ThisButton
    Unload Me
End Sub

Don
 
Lijkt mij handiger als je het complete formulier (is dus een bestand met de form) meestuurt.
 
Hoop niet dat dat de originele gegevens zijn in dat lijstje...
 
pffff

Mr.Music dedankt voor je melding
Ik was zo gefocus op een oplossing dat ik deze fout heb gemaakt

Dat was even schrikken
bestand met aangepaste gegevens

Bekijk bijlage zuid4.xlsm
 
Laatst bewerkt:
De eigenschap 'Value' van de spinbutton "SB_month" is ingesteld op 1. Maak er 0 van.
 
#5
Super dat is de oplossing
Heel erg bedankt voor je hulp.
Don
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan