MyTetra Share
Делитесь знаниями!
034. Использование календаря: ActiveX Calendar
16.03.2019
23:43
Раздел: !Закладки - VBA - Access - leadersoft.ru

Данный пример показывает как можно создать календарь, используя ActiveX Calendar от Microsoft. Поставьте ссылку на C:\Program Files\Microsoft Office\OFFICE11\MSCALL.OCX. Применяется класс для создания календаря.

Все примеры Microsoft Access
Option Compare Database
Option Explicit

Public WithEvents CurrentCal As MicrosoftCal

'   Настройка календаря
Private Sub Form_Load()
    Set CurrentCal = New MicrosoftCal
    Set CurrentCal.Cal = Me.myCal.Object
    With Me.CurrentCal.Cal ' Настройка календаря
        '.Value = Date ' Установка текущей даты
        .TitleFontColor = 255 ' Цвет заголовка
        .Year = Year(Date' Устанавливаем год
        .Month = Month(Date' Устанавливаем месяц
        .Day = Day(Date' Уставливаем день
        .NextDay ' Следующий день
        '.ShowTitle = False ' Гасим заголовок
        ' Введите точку и установите параметр
    End With
End Sub


'   Добавим событие-сообщение для нового класса
Public Sub CurrentCal_Progress(myMsg As String)
    If Me.butEvents Then
        Me.myEvents = myMsg & vbNewLine & Me.myEvents
        DoEvents
    End If
End Sub


'   Установлена дата
Public Sub myCal_AfterUpdate()
    'CurrentCal_Progress "Date: " & Me.myCal
End Sub


'   События для формы
Private Sub myCal_GotFocus()
    CurrentCal_Progress "GotFocus"
End Sub

Private Sub myCal_LostFocus()
    CurrentCal_Progress "LostFocus"
End Sub

Private Sub butEvents_AfterUpdate()
    Me.myEvents = ""
End Sub


'==============================================================

' Объявляем класс Calendar
Public WithEvents Cal As Calendar

' Объявляем событие для сообщений
Public Event progress(strMsg As String)

'==============================================================
'  События при создании/уничтожении класса
Private Sub Class_Initialize()
   ' Инициализация
End Sub

Private Sub Class_Terminate()
   ' Сохраняем данные
End Sub


'==============================================================
'  События до/после редактирования метки узла
Private Sub Cal_AfterUpdate()
   funPrintEvent "AfterUpdate: " & Me.Cal.Value
End Sub

Private Sub Cal_BeforeUpdate(Cancel As Integer)
   funPrintEvent "BeforeUpdate: " & Me.Cal.Value
End Sub

Private Sub Cal_NewMonth()
   funPrintEvent "NewMonth: " & Me.Cal.Value
End Sub

Private Sub Cal_NewYear()
   funPrintEvent "NewYear: " & Me.Cal.Value
End Sub


'==============================================================
'  События мышки
Private Sub Cal_Click()
   funPrintEvent "Click"
End Sub

Private Sub Cal_DblClick()
   funPrintEvent "DblClick"
End Sub


'==============================================================
'  События клавиатуры
Private Sub Cal_KeyDown(KeyCode As IntegerByVal Shift As Integer)
   funPrintEvent "KeyDown (KeyCode: " & KeyCode & ", Shift = " & Shift & ")"
End Sub

Private Sub Cal_KeyPress(KeyAscii As Integer)
   funPrintEvent "KeyPress: " & KeyAscii
End Sub

Private Sub Cal_KeyUp(KeyCode As IntegerByVal Shift As Integer)
    funPrintEvent "KeyUp (KeyCode: " & KeyCode & ", Shift = " & Shift & ")"
End Sub


'==============================================================
'   Функция сообщающая о получении событий
Private Function funPrintEvent(myMsg As String)
    RaiseEvent progress(myMsg) ' Генерируем событие для узла
End Function

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования