Использование календаря: ActiveX Calendar

MyTetra Share

Делитесь знаниями!

Ссылка на оригинал

Время создания: 16.03.2019 23:43

Раздел: Разные закладки - VBA - Access - leadersoft.ru

Запись: xintrea/mytetra_db_adgaver_new/master/base/1531373424nfeoc0lv3y/text.html на raw.githubusercontent.com

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

Свойства продукта

Microsoft Office: 2000,2002,2003,2007,2010	Архив с файлами: Перейти
Операционная система: Windows XP,Vista	Применение: Базы данных Access
Продажа: Купить	Файл исходника: ..\Access\01 Автоматизация\la_automat.mdb
Язык интерфейса: Русский

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 Integer, ByVal 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 Integer, ByVal 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.65