|
Вариантов программного создания собственного календаря много, но если
Вы выбрали Microsoft Excel, то имеет смысл начать со способа, где
для вывода информации используются ячейки,
т.е. :
Откройте рабочую книгу, в которой Вы предполагаете
создать календарь
Активируйте нужный рабочий лист
Выберите диапазон ячеек, состоящий из 42 ячеек
= 6 строк X 7 столбцов (при желании можно добавить
заголовок(шапку), содержащий перечень всех дней недели)
Присвойте этому
диапазону имя,
например, Календарь
(этот пункт не является обязательным, т.е. в нижеопубликованном макросе,
вместо Range("Календарь") можно использовать Range("B3:H8") или [B3:H8],
однако, этот финт позволит избежать проблем, если удаление/добавление
ячеек, вызовет изменение адресации)
Выберите ячейку, в которой в дальнейшем будет
выбираться месяц
Присвойте этой
ячейке имя,
например, Месяц (этот пункт также не является обязательным, см.выше)
В меню Данные выберите команду Проверка
и в появившемся стандартном диалоговом окне Проверка вводимых значений,
в поле со списком Тип данных: выберите Список, а в текстовом
поле Источник: введите
(или вставьте предварительно скопированный) нижеприведённый текст
Январь;Февраль;Март;Апрель;Май;Июнь;Июль;
Август;Сентябрь;Октябрь;Ноябрь;Декабрь
Выберите ячейку, в которой будет выбираться год
Присвойте этой
ячейке имя, например,
Год (и этот пункт тоже можно пропустить, см.выше)
В меню Данные выберите команду Проверка
и в появившемся стандартном диалоговом окне Проверка вводимых значений,
в поле со списком Тип данных: выберите Список, а в текстовом
поле Источник: введите необходимые года (не забывая, что максимально
допустимое количество символов, включая разделители, составляет 255)
В меню Вставка выберите пункт Имя и команду
Присводить. В появившемся стандартном диалоговом окне
Присвоение имени, текстовом поле Имя: введите Список,
а в текстовом поле Формула: введите, а лучше, вставьте предварительно
скопированный нижеприведённый текст
={"Январь";"Февраль";"Март";"Апрель";"Май";"Июнь";"Июль";
"Август";"Сентябрь";"Октябрь";"Ноябрь";"Декабрь"}
Комментарий : На самом деле, создание именованной формулы
также не является обязательным условием, ибо определить номер месяца,
исходя из его названия можно, например, так :
iMonth = Application.Match([Месяц].Value, Array( _
"Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", _
"Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь"), 0) |
Или так, если у Вас установлен руссифицированный офис :
| iMonth = Application.Match([Месяц], Application.GetCustomListContents(4), 0) |
Или даже так, при условии, что у Вас установлен Microsoft Excel 2000 (или старше) :
| iMonth = Application.Match([Месяц], Split([Месяц].Validation.Formula1, ";"), 0) |
Впрочем, без программного использования стандартной функции рабочего листа
=ПОИСКПОЗ() / Match() мы также можем обойтись, если воспользуемся VB функцией
DatePart()
| iMonth = DatePart("m", "01-" & [Месяц] & "-" & iYear) |
| iMonth = DatePart("m", [Месяц] & " " & iYear) |
Измените параметры форматирования у ячеек диапазона
Календарь, а также Месяц, Год в соответствии со
своими требованиями.
Подведите курсор мышки к ярлычку рабочего листа, затем,
кликните правой кнопкой мышки, и в появившемся контекстом меню выберите
команду Исходный текст (или выберите нужный модуль в редакторе VBA)
Скопируйте в модуль листа нижеопубликованный макрос
и сохраните изменения
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [Год, Месяц]) Is Nothing Then
Dim iYear%, iMonth%, iDay%, iOffset%, iCount%
Dim iMin As Date, iMax As Date, iArrDays(5, 6)
iYear = [Год].Value
iMonth = [Match(Месяц, Список, 0)]
iMin = DateSerial(iYear, iMonth, 1)
iMax = DateSerial(iYear, iMonth + 1, 1)
iOffset = WeekDay(iMin, vbMonday) - 2
For iDay = 1 To iMax - iMin
iCount = iDay + iOffset
iArrDays(iCount \ 7, iCount Mod 7) = iDay
Next
[Календарь].Value = iArrDays
End If
End Sub |
Примечание : Если же Вам необходимо определить ячейки без дат
(пустышки), например, для того, чтобы изменить цвет заливки таких ячеек
( хотя это можно осуществить и с помощью условного форматирования,
см. пример#2 ), то :
| Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [Год, Месяц]) Is Nothing Then
Dim iYear%, iMonth%, iDay%, iOffset%, iCount%
Dim iArrDays(5, 6) ' iArrDays(0 To 5, 0 To 6)
iYear = [Год].Value
iMonth = [Match(Месяц, Список, 0)]
iOffset = WeekDay(DateSerial(iYear, iMonth, 1), vbMonday) - 1
For iCount = 0 To 41
iDay = iCount - iOffset + 1
If Month(DateSerial(iYear, iMonth, iDay)) = iMonth Then
iArrDays(iCount \ 7, iCount Mod 7) = iDay
'Else
' MsgBox "Это - пустышка", , ""
End If
Next
[Календарь].Value = iArrDays
End If
End Sub |
или
| Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [Год, Месяц]) Is Nothing Then
Dim iMonth%, iYear%, iCount%, iMin As Date, iDate As Date
Dim iArrDays(5, 6) ' iArrDays(0 To 5, 0 To 6)
iYear = [Год].Value
iMonth = [Match(Месяц, Список, 0)]
iMin = DateSerial(iYear, iMonth, 1)
iMin = iMin - WeekDay(iMin, vbMonday) + 1
For iCount = 0 To 41
iDate = iMin + iCount
If Month(iDate) = iMonth Then
iArrDays(iCount \ 7, iCount Mod 7) = Day(iDate)
'Else
' MsgBox "Это - пустышка", , ""
End If
Next
[Календарь].Value = iArrDays
End If
End Sub |
или
| Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, [Год, Месяц]) Is Nothing Then
Dim iYear%, iMonth%, iOffset%, iCount%
Dim iMin As Date, iMax As Date, iDate As Date
Dim iArrDays(5, 6) ' iArrDays(0 To 5, 0 To 6)
iYear = [Год].Value
iMonth = [Match(Месяц, Список, 0)]
iMin = DateSerial(iYear, iMonth, 1)
iMax = DateSerial(iYear, iMonth + 1, 1) - 1
iOffset = WeekDay(iMin, vbMonday) - 1
For iCount = 0 To 41
iDate = iMin + iCount - iOffset
Select Case iDate
Case iMin To iMax
iArrDays(iCount \ 7, iCount Mod 7) = Day(iDate)
'Case Else
' MsgBox "Это - пустышка", , ""
End Select
Next
[Календарь].Value = iArrDays
End If
End Sub |
Теперь, если при открытии книги с календарём Вы разрешите выполнение
макросов, и предварительно, не установите высокий уровень безопасности
(MS Excel 2000, XP), то после выбора(или ввода) нужного месяца и года в
соответствующих ячейках, Вы получите необходимый календарь.
Разумеется, Вы
можете изменить и "инструмент" позволяющий выбирать месяц/год, например,
использовать для этого родной элемент управления Поле со списком
с панели инструментов Формы
(см. пример#2),
или разместить перечень годов в ячейках рабочего листа и связать
выпадающие списки с этими ячейками.
В общем, простор для творчества имеется, от себя лишь добавлю,
что если Вам понадобится копировать дату в буфер обмена, например, после
двойного клика в соответствующей ячейке календаря, то просто добавьте в
модуль листа, ещё одно событие :
| Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
If Not Intersect(Target, [Календарь]) Is Nothing Then
Cancel = True
If Application.IsNumber(Target) = True Then
Dim iClipboard As New MSForms.DataObject
iClipboard.SetText DateSerial([Год], [Match(Месяц, Список, 0)], Target), 1
'iClipboard.SetText Target & "-" & [Месяц] & "-" & [Год], 1
iClipboard.PutInClipboard
End If
End If
End Sub |
Автор :
Климов Павел Юрьевич
| | |
|
© 2004-2016 Климов П.Ю. Все права защищены. |
WebDesign & Error's
Klimoff
|