something wrong in the form of Interactive calendar

[david2005wang]

' Label1-Lable42 stands for each specific day of month
Private currentMonth As Date
Private Sub UserForm_Initialize()
currentMonth = DateSerial(Year(Date), Month(Date), 1) 'CurrentMonth=DateSerial such as "12/31/2024"
UserForm1.Caption = "MyCalander"
For i = 1 To 7
Me.Controls("LabelDay" & i).Caption = dayNames(i - 1)
Next i
Call UpdateCalendar
End Sub

Private Sub UpdateCalendar()
Dim firstDayOfMonth As Date
Dim i As Integer
Dim today As Date 'You can highlight to day's date if it falls within the current month displayed:

today = Date 'Date = current day

firstDayOfMonth = DateSerial(Year(currentMonth), Month(currentMonth), 1)
' Clear existing dates
For i = 1 To 42 ' 6 weeks • 7 days
Me.Controls("Label" & i).Caption = ""
Next i
Dim dayCounter As Integer
dayCounter = 1

If Month(today) = Month(currentMonth) And Year(today) = Year(currentMonth) Then
Dim todayLabelindex As Integer
todayLabelindex = Weekday(firstDayOfMonth) + day(today) - 1
Me.Controls("Label" & todayLabelindex).BackColor = vbYellow ' Highlight color
End If

For i = Weekday(firstDayOfMonth) To Weekday(firstDayOfMonth) + DaysInMonth(currentMonth) - 1
Me.Controls("Label" & i).Caption = dayCounter
dayCounter = dayCounter + 1
Next i
'LabelMonth.Caption = Year(currentMonth)
Me.LabelMonth.Caption = Format(currentMonth, "MMMM YYYY")
End Sub

Private Function DaysInMonth(anyDate As Date) As Integer
DaysInMonth = day(DateSerial(Year(anyDate), Month(anyDate) + 1, 0)) 'DateSerial(Year, Month+1, 0) Return the Last dayNumber of currentMonth
End Function

Private Sub CommandButtonNext_Click()
currentMonth = DateAdd("M", 1, currentMonth) ' increase "1" Month from currentMonth, DateAdd ( interval, number, date )Interval
'The time/date interval that you wish to add. It can be one of the following values: Value Explanation yyyy Year, q Quarter,m Month,y Day of the year,d Day
'w Weekday,ww Week,h Hour,n Minute,s Second
Call UpdateCalendar
End Sub

Private Sub CommandButtonPrevious_Click()
currentMonth = DateAdd("M", -1, currentMonth)
Call UpdateCalendar
End Sub

'Add a Click event for each day label
Private Sub Label1_Click()
HandleDateClick 1
End Sub
......
Private Sub Label42_Click()
HandleDateClick 42
End Sub

Private Sub HandleDateClick(ByVallabelIndex As Integer)
Dim selectedDate As Date
selectedDate = DateSerial(Year(currentMonth), Month(currentMonth), Me.Controls("Label" & labelIndex).Caption)
MsgBox "Selected Date: " & selectedDate

End Sub

Everthing runs well, but after insert the Private Sub Label1_Click() , and Private Sub HandleDateClick(ByVallabelIndex As Integer),
My question, when click the day label1 or 2 of the month in the form, it shows error as image "can't not find the specified object"

cound you guy double check and return with the reason?
thanking you so much!

david

 

[dmt32]

Hi,
There needs to be a SPACE between the declared passing mechanism & the parameter name

Private Sub HandleDateClick(ByVal labelIndex As Integer)
Dim selectedDate As Date
selectedDate = DateSerial(Year(currentMonth), Month(currentMonth), Me.Controls("Label" & labelIndex).Caption)
MsgBox "Selected Date: " & selectedDate

End Sub

Dave

 

[david2005wang]

' Label1-Lable42 stands for each specific day of month
Private currentMonth As Date
Private Sub UserForm_Initialize()
currentMonth = DateSerial(Year(Date), Month(Date), 1) 'CurrentMonth=DateSerial such as "12/31/2024"
UserForm1.Caption = "MyCalander"
For i = 1 To 7
Me.Controls("LabelDay" & i).Caption = dayNames(i - 1)
Next i
Call UpdateCalendar
End Sub

Private Sub UpdateCalendar()
Dim firstDayOfMonth As Date
Dim i As Integer
Dim today As Date 'You can highlight to day's date if it falls within the current month displayed:

today = Date 'Date = current day

firstDayOfMonth = DateSerial(Year(currentMonth), Month(currentMonth), 1)
' Clear existing dates
For i = 1 To 42 ' 6 weeks • 7 days
Me.Controls("Label" & i).Caption = ""
Next i
Dim dayCounter As Integer
dayCounter = 1

If Month(today) = Month(currentMonth) And Year(today) = Year(currentMonth) Then
Dim todayLabelindex As Integer
todayLabelindex = Weekday(firstDayOfMonth) + day(today) - 1
Me.Controls("Label" & todayLabelindex).BackColor = vbYellow ' Highlight color
End If

For i = Weekday(firstDayOfMonth) To Weekday(firstDayOfMonth) + DaysInMonth(currentMonth) - 1
Me.Controls("Label" & i).Caption = dayCounter
dayCounter = dayCounter + 1
Next i
'LabelMonth.Caption = Year(currentMonth)
Me.LabelMonth.Caption = Format(currentMonth, "MMMM YYYY")
End Sub

Private Function DaysInMonth(anyDate As Date) As Integer
DaysInMonth = day(DateSerial(Year(anyDate), Month(anyDate) + 1, 0)) 'DateSerial(Year, Month+1, 0) Return the Last dayNumber of currentMonth
End Function

Private Sub CommandButtonNext_Click()
currentMonth = DateAdd("M", 1, currentMonth) ' increase "1" Month from currentMonth, DateAdd ( interval, number, date )Interval
'The time/date interval that you wish to add. It can be one of the following values: Value Explanation yyyy Year, q Quarter,m Month,y Day of the year,d Day
'w Weekday,ww Week,h Hour,n Minute,s Second
Call UpdateCalendar
End Sub

Private Sub CommandButtonPrevious_Click()
currentMonth = DateAdd("M", -1, currentMonth)
Call UpdateCalendar
End Sub

'Add a Click event for each day label
Private Sub Label1_Click()
HandleDateClick 1
End Sub
......
Private Sub Label42_Click()
HandleDateClick 42
End Sub

Private Sub HandleDateClick(ByVallabelIndex As Integer)
Dim selectedDate As Date
selectedDate = DateSerial(Year(currentMonth), Month(currentMonth), Me.Controls("Label" & labelIndex).Caption)
MsgBox "Selected Date: " & selectedDate

End Sub

Everthing runs well, but after insert the Private Sub Label1_Click() , and Private Sub HandleDateClick(ByVallabelIndex As Integer),
My question, when click the day label1 or 2 of the month in the form, it shows error as image "can't not find the specified object"

cound you guy double check and return with the reason?
thanking you so much!

david

correct. thanks.

 

[dmt32]

most welcome - glad issue resolved & appreciate your feedback

Dave