Создать календарь на Excel

[Csandr]

Привет, прошу помочь мне в запутанной программе... Юзал поиск и нашел "Календарь на 1 месяц"

Sub q()
год = Range("E3").Value
номер_месяца = Range("E4").Value
Select Case номер_месяца
Case 1, 3, 5, 7, 8, 10, 12
число_дней_в_месяце = 31
Case 2
If год Mod 4 = 0 Then число_дней_в_месяце = 29 Else число_дней_в_месяце = 28
Case Else
число_дней_в_месяце = 30
End Select
месяц_и_год = MonthName(номер_месяца) + Str(год) + " года"
Range("A6").Value = месяц_и_год
Range("A8").Value = "Пн"
Range("A9").Value = "Вт"
Range("A10").Value = "Ср"
Range("A11").Value = "Чт"
Range("A12").Value = "Пт"
Range("A13").Value = "Сб"
Range("A14").Value = "Вс"
дата1 = "1" + "." + Str(номер_месяца) + "." + Str(год)
номер_дня_недели_1_числа_месяца = Weekday(дата1, 1) - 1
Range("B7").Activate
For i = 1 To номер_дня_недели_1_числа_месяца - 1
ActiveCell.Cells(2).Activate
Next i
количество_дней_в_1_столбце = 7 - номер_дня_недели_1_числа_месяца + 1
For i = 1 To количество_дней_в_1_столбце
ActiveCell.Cells(2).Activate
ActiveCell.Value = i
Next i
количество_полных_столбцов = (число_дней_в_месяце - количество_дней_в_1_столбце) / 7
записываемое_число = количество_дней_в_1_столбце + 1
For g = 1 To количество_полных_столбцов
For i = 1 To 7
ActiveCell.Cells(0).Activate
Next i
ActiveCell.Cells(1, 2).Activate
For i = 1 To 7
ActiveCell.Cells(2).Activate
ActiveCell.Value = записываемое_число
записываемое_число = записываемое_число + 1
Next i
Next g
If записываемое_число <= число_дней_в_месяце Then ActiveCell.Cells(-6, 2).Activate
For i = 1 To число_дней_в_месяце - записываемое_число + 1
ActiveCell.Cells(2).Activate
ActiveCell.Value = записываемое_число
записываемое_число = записываемое_число + 1
Next i
End Sub
Sub f()
Range("B6:G14").Clear
Range("E3:E4").Clear
Range("A6").Clear
Range("E3").Activate
End Sub

Она выполняет всё круто... Но мне нужно, чтобы этот же самый код выполнялся через UserForm, ту бишь при выполнении макроса календарь открывался в отдельном окне...
Прошу помощи...

[EducatedFool]

Такой календарь нужен?
http://excelvba.ru/programmes/PrintContracts

Или такой?
http://excelvba.ru/tools/DatePicker

[Csandr]

Сообщение от EducatedFool

Или такой?
http://excelvba.ru/tools/DatePicker

Такой... Спс, если кому нужно, вот исходник этой проги

Public oDatePickerManager As samradDATE
Public fUseFading As Boolean
Public fIsWinNT As Boolean
Public sPathToIcon As String

Public Sub DisplayCalendar()
    Dim Переменная058 As Boolean
    Dim Переменная0173 As Date
    On Error Resume Next
    oDatePickerManager.EnsureCalendar
    oDatePickerManager.Calendar.LoadDate oDatePickerManager.LoadThisDate, True
    Set oDatePickerManager.Calendar.CellToChange = oDatePickerManager.SelectedCell
    Переменная0173 = oDatePickerManager.SelectedCell.Formula
    If Переменная0173 <> "12:00:00AM" Or oDatePickerManager.SelectedCell.Formula = "" Then
        oDatePickerManager.Calendar.ClearInfoText
    Else
        oDatePickerManager.Calendar.SetInfoText "Choosing a day will replace the current cells formula"
    End If
    If oDatePickerManager.Calendar.Top < 0 Then oDatePickerManager.Calendar.Top = 0
    If oDatePickerManager.Calendar.Left < 0 Then oDatePickerManager.Calendar.Left = 0
    oDatePickerManager.Calendar.Width = 147
    AdjustWindowStyle GetHwnd(oDatePickerManager.Calendar, True)
    oDatePickerManager.Calendar.Show
    FadeMenu GetHwnd(oDatePickerManager.Calendar, False)
End Sub

Public Sub AfterUserPicksADay()
    oDatePickerManager.LoadThisDate = oDatePickerManager.SelectedCell.Value
End Sub