Я использую пользовательский календарь в Excel, который активируется после двойного щелчка по ячейке. Проблема с порядком месяца и даты в первые 12 дней. Месяц ставится на первое место вместо дня (изменение формата даты на дд мммм гггг не помогает), поэтому макрос ставит 02 мая 2020 года вместо 05 февраля 2020 года.
Проблема возникает только при выборе первых 12 дней в календаре при нажатии на 13-31 календарь помещает дату в правильном формате, поэтому 05 февраля 2020 года. Файл Excel доступен здесь . Ниже вы можете найти весь код:
Dim Buttons() As New clsCmdButton
Sub Show_Cal()
'use class module to create commandbutton collection, then show calendar
Dim iCmdBtns As Integer
Dim ctl As Control
iCmdBtns = 0
For Each ctl In frmCalendar.Controls
If TypeName(ctl) = "CommandButton"
Then
If ctl.Name < > "CB_Close"
Then
iCmdBtns = iCmdBtns + 1
ReDim Preserve Buttons(1 To iCmdBtns)
Set Buttons(iCmdBtns).CmdBtnGroup = ctl
End If
End If
Next ctl
frmCalendar.Show
End Sub
Private Sub CB_Close_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim lYearsAdd As Long
Dim lYearStart As Long
lYearStart = Year(Date) - 10
lYearsAdd = Year(Date) + 10
With Me
For i = 1 To 12
.CB_Mth.AddItem Format(DateSerial(Year(Date), i, 1), "mmmm")
Next
For i = lYearStart To lYearsAdd
.CB_Yr.AddItem Format(DateSerial(i, 1, 1), "yyyy")
Next
.Tag = "Calendar"
.CB_Mth.ListIndex = Month(Date) - 1
.CB_Yr.ListIndex = Year(Date) - lYearStart
.Tag = ""
End With
Call Build_Calendar
End Sub
Private Sub CB_Mth_Change()
If Not Me.Tag = "Calendar"
Then Build_Calendar
End Sub
Private Sub CB_Yr_Change()
If Not Me.Tag = "Calendar"
Then Build_Calendar
End Sub
Sub Build_Calendar()
Dim i As Integer
Dim dTemp As Date
Dim dTemp2 As Date
Dim iFirstDay As Integer
With Me
.Caption = " " & .CB_Mth.Value & " " & .CB_Yr.Value
dTemp = CDate("01/" & .CB_Mth.Value & "/" & .CB_Yr.Value)
iFirstDay = WeekDay(dTemp, vbSunday)
.Controls("D" & iFirstDay).SetFocus
For i = 1 To 42
With.Controls("D" & i)
dTemp2 = DateAdd("d", (i - iFirstDay), dTemp)
.Caption = Format(dTemp2, "d")
.Tag = dTemp2
.ControlTipText = Format(dTemp2, "dd/mm/yyyy")
'add dates to the buttons
If Format(dTemp2, "mmmm") = CB_Mth.Value Then
If.BackColor < > & H80000016 Then.BackColor = & H80000018
If Format(Date, "dd mmmm yyyy") = Format(Date, "dd/mm/yyyy") Then.SetFocus
.Font.Bold = True
Else
If.BackColor < > & H80000016 Then.BackColor = & H8000000F
.Font.Bold = False
End If
'format the buttons
End With
Next
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("DateEntry")) Is Nothing Then Exit Sub
If Target.Value < > ""
Then Exit Sub
Set rngAC = Target
g_bForm = True
frmCalendar.Show_Cal
rngAC.NumberFormat = "dd mmmm yyyy"
rngAC.Value = g_sDate
rngAC.EntireColumn.AutoFit
End Sub