Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню Заметки | VBA : Календарь с использованием ActiveX элементов управления


Rambler's Top100


Counter CO.KZ

Если для ввода даты в активную ячейку, Вы надумали создать собственный календарь на пользовательской форме (UserForm), то ниже опубликован один из таких способов Скачать готовый пример :



Собственно, идея довольно простая, создать 42 кнопки = 6 строк X 7 столбцов , с именами, от CommandButton1 до CommandButton42 (см. первый скриншот) + необходимые элементы управления для выбора месяца и года

Более подробно :
  • Создайте одну Кнопку (CommandButton1)
  • Используя свойства Width и Height установите необходимые размеры (например 24x24)
  • Удалите весь текст кнопки, см. свойство Caption
  • Скопируйте эту кнопку, и последовательно создайте остальные шесть дней недели
  • Затем, копируйте уже все семь кнопок и вставьте пять раз подряд
  • Теперь вставьте ещё один раз, но т.к. полученный ряд должен служить заголовком(шапкой), то его необходимо расположить перед самой первой неделей
  • Если Вы не хотите, чтобы пользователь "вашего" календаря имел возможность нажимать кнопки-заголовки, то установите у последних семи кнопок значение свойства Locked как True
  • Используя свойство Caption, заполните эти семь кнопок днями недели, например, Пн, Вт, Ср, Чт, Пт, Сб, Вс
  • Создайте выпадающий список (ComboBox1)
  • Значение свойства Style установите как 2-fmStyleDropDownList
  • Значение свойства ListRows установите = 12
  • Создайте Текстовое поле (TextBox1)
  • Значение свойства Locked установите как True
  • Создайте Счётчик (SpinButton1)
  • Значение свойства Min установите = -10
  • Значение свойства Max установите = 10
    Если нужен больший/меньший период, то измените Min, Max в соответствии с Вашими запросами.

    Совет : Используя эти свойства, Вы можете сразу указать необходимый диапазон дат, например, от 1904 до 2504.

    Теперь самое главное, чтобы не городить огород и не создавать 42 события, по одному для каждой кнопки, и не создавать массив кнопок,

  • Просто создайте Надпись (Label1) и расположите этот элемент управления над всеми 42 кнопками (см. скриншот)



  • Удалите весь текст надписи, см. свойство Caption
  • Значение свойства BackStyle установите как 0-fmBackStyleTransparent
  • Теперь, просто скопируйте весь нижеопубликованный код в модуль формы с самодельным календарём и продумайте как вызывать эту форму.
  • '*************************************************************'
    '    Календарь на период от -10 до +10 от текущего года       '
    '    Период задаётся с помошью :                              '
    '    счётчика SpinButton1 и его свойств Min и Max             '
    '                                                             '
    '    Дата создания 1999 г., посл. изм. 2016 г.                '
    '    Автор Климов Павел Юрьевич                               '
    '    e-mail     msoffice@nm.ru                                '
    '    http://www.msoffice-nm.ru (http://www.msoffice.nm.ru)    '
    '*************************************************************'
    
    Private Sub UserForm_Initialize()
        TextBox1.Tag = Year(Now)
        TextBox1.Value = TextBox1.Tag
        
        ComboBox1.List = Application.GetCustomListContents(4)
        ComboBox1.ListIndex = Month(Now) - 1
    End Sub
    
    Private Sub ComboBox1_Change()
        CreateCalendar
    End Sub
    
    Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        Select Case KeyCode
            Case 38: If ComboBox1.ListIndex = 0 Then KeyCode = 0
            Case 40: If ComboBox1.ListIndex = 11 Then KeyCode = 0
        End Select
    End Sub
    
    Private Sub SpinButton1_Change()
        TextBox1.Value = Val(TextBox1.Tag) + SpinButton1.Value
        CreateCalendar
    End Sub
    
    Private Sub CreateCalendar()
         Dim iThisDay As Date, iFrstDay As Date
         Dim iMonth%, iYear%, iWeekDay%, iCount%
         
         iMonth = ComboBox1.ListIndex + 1
         iYear = Val(TextBox1.Value)
         iFrstDay = DateSerial(iYear, iMonth, 1)
         iWeekDay = WeekDay(iFrstDay, vbMonday) - 1
    
         For iCount = 1 To 42
             iThisDay = DateSerial(iYear, iMonth, iCount - iWeekDay)
             If Month(iThisDay) = iMonth Then
                Me("CommandButton" & iCount).Caption = Day(iThisDay)
             Else
                Me("CommandButton" & iCount).Caption = Empty '""
             End If
         Next
    End Sub
    
    Private Sub Label1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
        X = X \ Label1.Width / 7 + 1
        Y = Y \ Label1.Height / 6
    
        With Me("CommandButton" & X + Y * 7)
             If .Caption <> "" Then 'If Len(.Caption) > 0 Then
                ActiveCell.NumberFormat = "dd/mm/yyyy"
                ActiveCell = DateSerial(Val(TextBox1.Value), ComboBox1.ListIndex + 1, Val(.Caption))
                'ActiveCell.Columns.AutoFit 'ActiveCell.EntireColumn.AutoFit
                Unload Me
             End If
        End With
    End Sub
    Совет : Если Вы окончательно "утвердили" макет календаря и дальнейшее изменение размеров кнопок не предполагается, то вместо Label1.Width / 7 можно сразу указать ширину кнопки, а вместо Label1.Height / 6 её высоту.



    Пример(ы) можно скачать здесь




    Автор : Климов Павел Юрьевич
    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff