Greetings, I have a VBA that creates a calendar userform, but there is something wrong with it. For example, when I click on August 9th, the date that showed up would become September 8th instead. Could anyone check for me please? Thanks in advance
VBA Code:
Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMonth As Date
Dim CreateCalendar As Boolean
Dim i As Integer
Private Sub CB_Month_Change()
If Me.CB_Month.Value <> "" And Me.CB_Year.Value <> "" Then
Call Build_Calendar
End If
End Sub
Private Sub CB_Year_Change()
If Me.CB_Month.Value <> "" And Me.CB_Year.Value <> "" Then
Call Build_Calendar
End If
End Sub
Private Sub D1_Click()
Range("D9").Value = Me.D1.ControlTipText
Unload Me
End Sub
.
.
.
End Sub
Private Sub D42_Click()
Range("D9").Value = Me.D42.ControlTipText
Unload Me
End Sub
Private Sub Frame1_Click()
End Sub
Private Sub UserForm_Initialize()
Application.EnableEvents = False
' Set the startup position of the calendar form
Me.StartUpPosition = 0 ' Manual position
Me.Left = 548 ' Specify the desired left position in points
Me.Top = 260 ' Specify the desired top position in points
ThisDay = Date
ThisMonth = Format(ThisDay, "mm")
ThisYear = Format(ThisDay, "yyyy")
For i = 1 To 12
CB_Month.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
Next
CB_Month.ListIndex = Format(Date, "mm") - Format(Date, "mm")
For i = -2 To 2
If i = 1 Then CB_Year.AddItem Format(ThisDay, "yyyy") Else _
CB_Year.AddItem Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
Next
CB_Year.ListIndex = 3
CreateCalendar = True
Call Build_Calendar
Application.EnableEvents = True
End Sub
Private Sub Build_Calendar()
Dim selectedDate As Date
Dim firstDayOfMonth As Date
Dim currentDate As Date
selectedDate = DateValue("1 " & CB_Month.Value & " " & CB_Year.Value)
firstDayOfMonth = DateSerial(Year(selectedDate), Month(selectedDate), 1)
currentDate = firstDayOfMonth - Weekday(firstDayOfMonth) + 1
For i = 1 To 42
Controls("D" & i).Caption = Format(currentDate, "d")
Controls("D" & i).ControlTipText = Format(currentDate, "d/m/yyyy")
If Month(currentDate) = Month(selectedDate) Then
Controls("D" & i).BackColor = &HFFFFFF
Controls("D" & i).Font.Bold = True
Else
Controls("D" & i).BackColor = &HC0C0C0
Controls("D" & i).Font.Bold = False
End If
If DateValue(Controls("D" & i).ControlTipText) = ThisDay Then
Controls("D" & i).SetFocus
End If
currentDate = currentDate + 1
Next
End Sub
Last edited:
