With Application
slancalendar.Top = (Target.Top Mod Target.Row) + slancalendar.Height / 2 'Target.Top
slancalendar.Left = Target.Left + Target.Width
slancalendar.Show
End With

Option Explicit
Dim dt As Date, changing As Boolean
Dim d As Date, w&, mon&, cd As Date, dd As Date
Const ylen = 99 ' период дат, отображаемых в комбо годов - т.е. от 48 лет до указ даты и длиной в 99 лет
Dim dic As Object

Property Get Value() As Date
    Value = dt ' обеспечение обращения slancalendar.value
End Property

Private Sub combomon_Change()
    If changing Then Exit Sub ' отсекание циклических вызовов
    If combomon.ListIndex = -1 Then Exit Sub 'запрет произвольного ввода
    Call setcal(DateSerial(Val(comboyear.Text), combomon.ListIndex + 1, 1)) 'инициализация новой датой
    Application.SendKeys "{end}" 'чтобы без выделения
End Sub

Private Sub comboyear_Change()
    If changing Then Exit Sub ' отсекание циклических вызовов
    If comboyear.ListIndex = -1 Then ' при ручном вводе запрет инициализации до окончания ввода(enter)
        changing = True
        Exit Sub
    End If
    Call setcal(DateSerial(Val(comboyear.Text), combomon.ListIndex + 1, 1)) 'инициализация новой датой
    Application.SendKeys "{end}" 'чтобы без выделения
End Sub

Private Sub comboyear_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then ' реакция на нажатие интера
    changing = False ' разрешение последующей инициализации
    Call setcal(DateSerial(Val(comboyear.Text), combomon.ListIndex + 1, 1)) 'инициализация новой датой
End If
End Sub

Private Sub CommandButton1_Click()
    MsgBox "записано со слов вдохновения Новиковым А.Н.(aka slan)"
End Sub

Private Sub UserForm_Activate()
'Call setcal(Date) 'инициализация текущей датой
End Sub
Sub setcal(cd) ' cd - заданная дата
    ReDim y&(1 To ylen) ' выделение памяти по массив лет
    Dim cdt As Date, i&
    changing = True ' запрет циклических вызовов
    cdt = Date ' текущая дата - для выделения ее в календаре, если присутствует
    mon = Month(cd) ' месяц заданной даты
    combomon.ListIndex = mon - 1 ' отображение нужного месяца в списке
    y(ylen) = Year(cd) - Int(ylen / 2) ' начало перода дат в списке
    For i = 1 To ylen ' заполнение массива лет
        y(i) = y(ylen) + i
    Next
    comboyear.List = y ' заполнение списка лет
    comboyear.ListIndex = Int(ylen / 2) - 1 ' выделение нужного года
    d = cd - Day(cd) + 1 ' определение начала месяца
    w = Weekday(d, vbMonday) ' день недели начала месяца
    d = d - w ' дата начала заполнения календаря(понедельник недели начала месяца)
    For i = 1 To 42 ' заполнение чисел календаря
        dd = d + i
        With Me.Controls("label" & i) ' labelы заранее расположены в соответствующем порядке
            .Caption = Day(dd) ' число
            .Tag = CStr(dd) ' дата присваивается тэгу лэйбла, чтобы потом не искать
            If Month(dd) = mon Then .BackColor = &HC0E0FF Else .BackColor = &H80000004 ' закрашивание лэйблов месяца, соответствующего cd одним цветом, а остальных другим
            If dd = cdt Then .BackColor = &HFF8080 ' закрашивание текущей даты
        End With
    Next
    changing = False ' окончание инициализации

End Sub

Private Sub UserForm_Initialize()
    Set dic = CreateObject("Scripting.Dictionary")
    Dim cn As Control
    For Each cn In Me.Controls
        If TypeName(cn) = "Label" Then
            Set dic(cn.Name) = cn
        End If
    Next
    
    combomon.List = Array("январь", "февраль", "март", "апрель", "май", "июнь", "июль", "август", "сентябрь", "октябрь", "ноябрь", "декабрь")
Call setcal(Date) 'инициализация текущей датой
End Sub

Private Sub Label1_Click(): Labels_Click dic("Label1"): End Sub
Private Sub Label2_Click(): Labels_Click dic("Label2"): End Sub
Private Sub Label3_Click(): Labels_Click dic("Label3"): End Sub
Private Sub Label4_Click(): Labels_Click dic("Label4"): End Sub
Private Sub Label5_Click(): Labels_Click dic("Label5"): End Sub
Private Sub Label6_Click(): Labels_Click dic("Label6"): End Sub
Private Sub Label7_Click(): Labels_Click dic("Label7"): End Sub
Private Sub Label8_Click(): Labels_Click dic("Label8"): End Sub
Private Sub Label9_Click(): Labels_Click dic("Label9"): End Sub
Private Sub Label10_Click(): Labels_Click dic("Label10"): End Sub
Private Sub Label11_Click(): Labels_Click dic("Label11"): End Sub
Private Sub Label12_Click(): Labels_Click dic("Label12"): End Sub
Private Sub Label13_Click(): Labels_Click dic("Label13"): End Sub
Private Sub Label14_Click(): Labels_Click dic("Label14"): End Sub
Private Sub Label15_Click(): Labels_Click dic("Label15"): End Sub
Private Sub Label16_Click(): Labels_Click dic("Label16"): End Sub
Private Sub Label17_Click(): Labels_Click dic("Label17"): End Sub
Private Sub Label18_Click(): Labels_Click dic("Label18"): End Sub
Private Sub Label19_Click(): Labels_Click dic("Label19"): End Sub
Private Sub Label20_Click(): Labels_Click dic("Label20"): End Sub
Private Sub Label21_Click(): Labels_Click dic("Label21"): End Sub
Private Sub Label22_Click(): Labels_Click dic("Label22"): End Sub
Private Sub Label23_Click(): Labels_Click dic("Label23"): End Sub
Private Sub Label24_Click(): Labels_Click dic("Label24"): End Sub
Private Sub Label25_Click(): Labels_Click dic("Label25"): End Sub
Private Sub Label26_Click(): Labels_Click dic("Label26"): End Sub
Private Sub Label27_Click(): Labels_Click dic("Label27"): End Sub
Private Sub Label28_Click(): Labels_Click dic("Label28"): End Sub
Private Sub Label29_Click(): Labels_Click dic("Label29"): End Sub
Private Sub Label30_Click(): Labels_Click dic("Label30"): End Sub
Private Sub Label31_Click(): Labels_Click dic("Label31"): End Sub
Private Sub Label32_Click(): Labels_Click dic("Label32"): End Sub
Private Sub Label33_Click(): Labels_Click dic("Label33"): End Sub
Private Sub Label34_Click(): Labels_Click dic("Label34"): End Sub
Private Sub Label35_Click(): Labels_Click dic("Label35"): End Sub
Private Sub Label36_Click(): Labels_Click dic("Label36"): End Sub
Private Sub Label37_Click(): Labels_Click dic("Label37"): End Sub
Private Sub Label38_Click(): Labels_Click dic("Label38"): End Sub
Private Sub Label39_Click(): Labels_Click dic("Label39"): End Sub
Private Sub Label40_Click(): Labels_Click dic("Label40"): End Sub
Private Sub Label41_Click(): Labels_Click dic("Label41"): End Sub
Private Sub Label42_Click(): Labels_Click dic("Label42"): End Sub

Private Sub Labels_Click(oLabel As Object)
    dt = CDate(oLabel.Tag)
    ActiveCell.Value = dt
    Me.Hide
End Sub