Надстройка samradDatePicker (русифицированная) для облегчения ввода даты в ячейки листа Excel.
Добавляет в контекстное меня ячеек пункт выбора даты, а при выделении ячеек, содержащих дату, справа от ячейки отображает значок календаря.
Поместите файл надстройки из вложения в папку автозагрузки Excel (C:Program FilesMicrosoft OfficeOFFICExxXLSTART).
В контекстном меню ячеек появляется новый пункт — «Выбрать дату из календаря«.
Рядом с ячейками, в которые уже введена дата, будет отображаться маленький календарик, щелчок по которому вызовет большой календарь — для выбора даты.
Второй прикреплённый к статье файл — та же надстройка, только в которой неделя начинается с понедельника (в оригинале надстройки — с воскресенья)
Пароль на проект VBA — 1 (единица)
PS: Этот макрос написал не я (автор — samrad)
Файл с макросом взят на просторах интернета.
Поскольку макрос делал не я, — доработками его я не занимаюсь, никаких гарантий работы дать не могу, по использованию не консультирую.
Всплывающий календарь
Если вам часто приходится вводить даты в ячейки листа, то делать это вручную неудобно. Для ввода именно сегодняшней даты можно воспользоваться функцией СЕГОДНЯ (TODAY), сочетанием клавиш Ctrl+; или макросом, но если нужны разные даты из прошлого или будущего, то вбивать их руками долго.
К сожалению, в стандартном арсенале средств Excel нет встроенного выпадающего календаря (в отличие от Word), да еще и в последних версиях, начиная с Excel 2007, Microsoft зачем-то убрала из стандартного комплекта поставки библиотеку mscalc.osx, которая позволяла быстро создать пользовательскую форму с календарем.
Естественно, это «узкое место» не осталось без внимания опытных пользователей и экспертов Excel MVP, которые оперативно создали несколько интерактивных календарей на макросах для удобного ввода дат. Вот подборка неплохих, на мой взгляд, бесплатных вариантов:
 |
Windows Date Picker Автор: Ron de Bruin Цена: бесплатно Ссылка
|
 |
Excel Date Picker Автор: Jim Cone Цена: бесплатно Ссылка
|
 |
Mini Calendar and Date Picker Автор: VERTEX Цена: бесплатно. Ссылка в Office Apps Store
|
 |
Date Picker Автор: Sam Radakovitz, руководитель команды программистов Excel в Microsoft Цена: бесплатно Сайт автора умер, ссылки не работают, но можно скачать заботливо сохраненную мной когда-то копию здесь.
|
P.S.
Установка надстроек:
- в Excel 2003 и старше — меню Сервис — Надстройки — Обзор (Tools — Add-ins — Browse)
- в Excel 2007 и новее — Файл — Параметры — Надстройки — Перейти — Обзор (File — Options — Add-ins — Go To — Browse)
Ссылки по теме
- Всплывающий календарь из надстройки PLEX
- Автоматический ввод даты при изменении ячейки
VERTEX42
Get started with the add-in:
Open in Excel
This add-in works in: Excel 2016 or later on Mac, Excel on the web, Excel 2013 Service Pack 1 or later on Windows.
If you don’t have the above, try using Office Online.
Can’t find the add-in within Office
Enable editing, trust the add-in and look for the add-in in the insert tab under ‘My Add-ins’. Click here for step by step instructions
Need more help
For more on install Office add-ins, view our help documentation.
Содержание
- 0.1 P.S.
- 0.2 Ссылки по теме
- 1 Добавить «Всплывающий календарь» в Excel 2016, 2013, 2010, 2007
- 2 Как работать с надстройкой:
- 3 Как задать формат даты в Excel 2007/2010?
- 4 Как задать свой собственный формат даты? Как преобразовать дату в год, месяц либо день недели?
- 5 Как установить систему дат 1904?
- 6 Как вводить дату в ячейку?
- 7 Как в Excel вводить даты при помощи надстройки?
- 8 Как вставить в ячейку статическую, фиксированную, не обновляемую дату?
- 9 Как вставить в ячейку текущую автоматически обновляемую дату?
- 9.1 Другие материалы по теме:
- 9.2 Интерактивный календарь в Excel
- 9.3 Создаем таблицу с событиями
- 9.4 Настраиваем календарь
- 9.5 Задаем имя диапазону дат в календаре
- 9.6 Определяем ячейку с выделенной датой
- 9.7 Добавляем макрос на событие Worksheet_selectionchange()
- 9.8 Настраиваем формулы для отображения деталей при выборе даты
- 9.9 Добавление анонса
- 9.10 Настраиваем условное форматирование для выделенной даты
- 9.11 Форматируем
Если вам часто приходится вводить даты в ячейки листа, то делать это вручную неудобно. Для ввода именно сегодняшней даты можно воспользоваться функцией СЕГОДНЯ (TODAY), сочетанием клавиш Ctrl+; или макросом, но если нужны разные даты из прошлого или будущего, то вбивать их руками долго.
К сожалению, в стандартном арсенале средств Excel нет встроенного выпадающего календаря (в отличие от Word), да еще и в последних версиях, начиная с Excel 2007, Microsoft зачем-то убрала из стандартного комплекта поставки библиотеку mscalc.osx, которая позволяла быстро создать пользовательскую форму с календарем.
Естественно, это «узкое место» не осталось без внимания опытных пользователей и экспертов Excel MVP, которые оперативно создали несколько интерактивных календарей на макросах для удобного ввода дат. Вот подборка неплохих, на мой взгляд, бесплатных вариантов:
 |
Windows Date Picker Автор: Ron de Bruin Цена: бесплатно Ссылка
|
 |
Excel Date Picker Автор: Jim Cone Цена: бесплатно Ссылка
|
 |
Mini Calendar and Date Picker Автор: VERTEX Цена: бесплатно. Ссылка в Office Apps Store
|
 |
Date Picker Автор: Sam Radakovitz, руководитель команды программистов Excel в Microsoft Цена: бесплатно Сайт автора умер, ссылки не работают, но можно скачать заботливо сохраненную мной когда-то копию здесь.
|
P.S.
Установка надстроек:
- в Excel 2003 и старше — меню Сервис — Надстройки — Обзор (Tools — Add-ins — Browse)
- в Excel 2007 и новее — Файл — Параметры — Надстройки — Перейти — Обзор (File — Options — Add-ins — Go To — Browse)
Ссылки по теме
- Всплывающий календарь из надстройки PLEX
- Автоматический ввод даты при изменении ячейки
Каждый раз при вводе даты в ячейку возникают вопросы: печатать ДД-ММ-ГГГГ или в другом порядке? Использовать «-» или «/» в качестве разделителя? Распознает ли Excel введённое значение как дату и отобразит ли её в нужном формате? Именно в этих случаях пригодится всплывающий, или выпадающий, календарь. Он незаменим для работы с личными и рабочими списками дел, расписаниями и планами, графиками выполнения проектов и финансовыми отчётами в Excel.
«Всплывающий календарь» — это надёжный и проверенный инструмент выбора дат, которому доверяют 30 000+ пользователей Excel:
- Интуитивен в использовании: выберите ячейки — вставьте дату
- Выпадает рядом с ячейкой, отображает номера недель, дни недели, текущую дату
- Заполняет датами столбцы, строки и любые диапазоны в секунды
- Множество вариантов формата даты по умолчанию
- Работает в 64- и 32-разрядных версиях Excel
Язык видео: английский. Субтитры: русский, английский. (Внимание: видео может не отражать последние обновления. Используйте инструкцию ниже.)
Добавить «Всплывающий календарь» в Excel 2016, 2013, 2010, 2007
Подходит для: Microsoft Excel 2016 – 2007, desktop Office 365 (32-бит и 64-бит).
Скачать надстройку XLTools
Как работать с надстройкой:
- Как вставить или изменить дату в ячейке с помощью «Всплывающего календаря»
- Как из календаря вставить текущую дату в ячейку
- Как заполнить датами целый столбец, строку или несмежные диапазоны
- Как заполнить диапазон последовательными датами
- Как вставить сразу и дату и время в ячейку
- Как вставить только время (без даты) в ячейку
- Как изменить формат даты по умолчанию для «Всплывающего календаря»
- Как изменить комбинацию горячих клавиш для «Всплывающего календаря»
- Как добавить/удалить иконку «Всплывающего календаря»
- Как добавить/удалить «Всплывающий календарь» из контекстного меню
- Как встроить всплывающий календарь в книгу Excel
Внимание: отмена последнего действия (UNDO) невозможна. Рекомендуем сохранять резервную копию файлов или использовать «Контроль версий» XLTools для отслеживания изменений.
Как вставить или изменить дату в ячейке с помощью «Всплывающего календаря»
- Выберите ячейку.
- В группе Дата/Время нажмите на кнопку «Вставить дату» > Календарь всплывёт рядом с ячейкой.
Или: по правому клику мыши выберите пункт «Вставить дату».
Или: используйте сочетание клавиш Ctrl+; (точка с запятой на английской раскладке). - Выберите нужную дату из календаря > Готово.
Обратите внимание на формат: это то, что вам нужно? Вы можете изменить формат даты по умолчанию. - Чтобы изменить значение даты, нажмите на иконку календаря справа от ячейки > Измените дату.
«Всплывающий календарь» запоминает последнюю использованную дату, чтобы вам было проще вводить следующую дату.
Внимание: после ввода даты, ячейке автоматически присваивается формат Число/Дата. Если вы позднее удалите значение из ячейки, сама ячейка сохранит свой формат Дата, а иконка календаря для этой пустой ячейки останется доступной. Чтобы убрать иконку, измените формат ячейки на Общий.
Как из календаря вставить текущую дату в ячейку
- Выберите ячейку, в которую нужно вставить текущую дату.
- В группе Дата/Время нажмите на кнопку «Вставить дату» > Календарь появится рядом с ячейкой.
Или: по правому клику мыши выберите пункт «Вставить дату».
Или: используйте сочетание клавиш Ctrl+; (точка с запятой на английской раскладке). - Нажмите по надписи «Сегодня» в нижней части календаря > Готово.
Как заполнить датами целый столбец, строку или несмежные диапазоны
С помощью «Всплывающего календаря» вы можете заполнить значениями дат целый диапазон (ограничение до 4000 ячеек). Даты можно вставить в столбцы таблицы, строки, объединённые ячейки или любой произвольный диапазон точно так же, как одну ячейку:
- Выберите диапазон.
- В группе Дата/Время нажмите на кнопку «Вставить дату» > Появится всплывающий календарь.
Или: по правому клику мыши выберите пункт «Вставить дату».
Или: используйте сочетание клавиш Ctrl+; (точка с запятой на английской раскладке). - Выберите дату > Готово. Весь диапазон заполнен значением выбранной даты.
Совет: узнайте, как заполнить ячейки последовательными датами. - Чтобы изменить значение даты, нажмите на иконку календаря справа от ячейки > Измените дату.
Внимание: после ввода даты, ячейкам автоматически присваивается формат Число/Дата. Если вы позднее удалите значения из ячеек, сами ячейки сохранят свой формат Дата, а иконка календаря для этих пустых ячеек останется доступной. Чтобы убрать иконку, измените формат ячеек на Общий.
Как заполнить диапазон последовательными датами
С надстройкой «Всплывающий календарь» вы можете быстро заполнить диапазон последовательными датами (дни по порядку):
- Вкладка XLTools > Кнопка «Настройки» > Вкладка Дата/Время > Отметьте флажком «Включить автоувеличение дат при заполнении диапазона ячеек» > OK.
- Выберите диапазон.
- В группе Дата/Время нажмите на кнопку «Вставить дату» > Всплывающий календарь появятся рядом с ячейкой.
Или: по правому клику мыши выберите пункт «Вставить дату».
Или: используйте сочетание клавиш Ctrl+; (точка с запятой на английской раскладке). - Выберите начальную дату > Готово, весь диапазон будет автоматически заполнен последовательными значениями дат с шагом в 1 день.
Как вставить сразу и дату и время в ячейку
- Выберите ячейку.
- В группе Дата/Время нажмите на кнопку «Вставить дату и время» > Всплывающий календарь с часами появятся рядом с ячейкой.
Или: по правому клику мыши выберите пункт «Вставить дату и время».
Или: используйте сочетание клавиш: нажмите Ctrl+; (точка с запятой на английской раскладке), затем отпустите клавиши и нажмите Ctrl+Shift+; (точка с запятой на английской раскладке). - Установите время при помощи колеса прокрутки мыши или стрелок Вверх/Вниз > Выберите дату из всплывающего календаря > Готово.
Обратите внимание на формат: это то, что вам нужно? Вы можете задать другой формат по умолчанию для Всплывающего Календаря и Часов. - Чтобы изменить значение, нажмите на иконку справа от ячейки > Измените дату и время.
Внимание: после ввода даты и времени, ячейке автоматически присваивается формат Число/Дата. Если вы позднее удалите значение из ячейки, сама ячейка сохранит свой формат Дата, а иконка календаря с часами для этой пустой ячейки останется доступной. Чтобы убрать иконку, измените формат ячейки на Общий.
Как вставить только время (без даты) в ячейку
Используйте надстройку «Всплывающие часы» для установки и вставки времени в ячейки и диапазоны:
- Выберите ячейку или диапазон.
- В группе Дата/Время нажмите на кнопку «Вставить время» > Всплывающие часы появятся рядом с ячейкой.
Или: по правому клику мыши выберите пункт «Вставить время».
Или: используйте сочетание клавиш Ctrl+Shift+; (точка с запятой на английской раскладке). - Установите время при помощи колеса прокрутки мыши или стрелок Вверх/Вниз > Нажмите Ввод (Enter) > Готово.
Как изменить формат даты по умолчанию для «Всплывающего календаря»
Чтобы изменить формат, заданный по умолчанию для «Всплывающего Календаря»:
- Нажмите кнопку «Настройки» на панели XLTools > Вкладка Дата/Время.
- Отметьте флажком «По умолчанию использовать формат даты и времени, установленный ниже».
Внимание: при снятии флажка Всплывающий календарь будет использовать формат, установленный в ваших системных настройках. - Выберите подходящий формат, напр., принятый в вашей стране или на вашем языке.
Или: задайте «Свой формат». - Нажмите OK > Готово.
Вы можете обнаружить, что некоторые ячейки не подчиняются заданному формату Календаря. Это означает, что ячейкам ранее был присвоен другой формат даты. В этом случае, измените формат ячеек:
- Выберите ячейки > По правому клику мыши выберите «Формат ячеек».
- Вкладка «Число» > Формат «Дата» > Установите нужный формат даты.
Изначально Всплывающий календарь использует ваши системные настройки формата даты и времени по умолчанию. Вы можете полностью изменить настройки системы. Обратите внимание, это поменяет настройки всех учётных записей на компьютере:
- Панель управления > Часы, язык и регион > Изменение форматов даты.
- Вкладка Форматы > Установите форматы дат и времени, первого дня недели.
- Вкладка Местоположение > Укажите страну местонахождения.
- Вкладка Дополнительно > Измените язык системы > Перезагрузите компьютер.
Для вашего удобства, для «Всплывающего календаря» по умолчанию задано сочетание клавиш Ctrl+; (точка с запятой на английской раскладке) – это та же комбинация, которая используется в Excel для вставки текущей даты. Вы можете изменить горячие клавиши для «Всплывающих часов» в любое время:
Вкладка XLTools > Кнопка «Настройки» > Вкладка «Горячие клавиши» > Задайте другое сочетание > OK.
Как добавить/удалить иконку «Всплывающего календаря»
Пиктограмма (иконка) календаря появляется справа от выбранной ячейки, если для ячейки задан формат Дата. Нажатие на иконку открывает инструмент выбора даты.
- Чтобы отключить отображение иконки Календаря:
- Нажмите кнопку «Настройки» на панели XLTools > Вкладка Дата/Время.
- Снимите флажок с опции «Отображать пиктограммы Всплывающего Календаря и Часов» > OK.
- Готово! Пиктограммы перестанут отображаться, Календарь и Часы будут по-прежнему доступны для использования. Иконки можно вернуть в любое время.
- Чтобы настроить появление иконки рядом с пустыми ячейками, столбцами, строками или произвольным диапазоном:
- Выберите пустую ячейку или диапазон.
- Вкладка «Главная» > Группа «Число» > Дата > OK. Так, ячейкам будет присвоен формат даты.
Или: вставьте любую дату с помощью «Всплывающего календаря» > Нажмите кнопку Delete. Это удалит непосредственно значения, и присвоит выбранным ячейкам формат даты. - Готово! Теперь, если вы выберите какую-либо ячейку в этом диапазоне, рядом с ней появится иконка Календаря.
- Чтобы убрать иконку Календаря с пустых ячеек:
Если ячейка пуста, но иконка по-прежнему появляется, значит, что ячейке присвоен формат даты или времени. Чтобы убрать иконку с пустых ячеек, измените их формат на Общий:
- Выберите пустую ячейку или диапазон.
- Вкладка «Главная» > Группа «Редактирование» > Очистить форматы.
Или: вкладка «Главная» > Группа «Число» > Выберите «Общий» из выпадающего списка.
Или: по правому клику «Формат ячеек» > Вкладка «Число» > Выберите формат «Общий» > OK.
- Нажмите кнопку «Настройки» на панели XLTools > Вкладка Дата/Время.
- Установите или снимите флажки соответствующих опций:
- «Добавить пункт «Вставить дату» в контекстное меню»
- «Добавить пункт «Вставить время» в контекстное меню»
- «Добавить пункт «Вставить дату и время» в контекстное меню»
- Нажмите OK > Готово.
Как встроить всплывающий календарь в книгу Excel
Надстройка XLTools «Всплывающий календарь» не может быть встроена в книгу. «Всплывающий календарь» будет видим и доступен только тем пользователям, у кого установлена надстройка XLTools.
Если вам нужно отправить книгу другим пользователям, попробуйте наш встраиваемый календарь — онлайн надстройка XLTools.net Календарь. Установка на компьютер не требуется: отправьте файл коллегам, и они тоже смогут воспользоваться календарём. Это веб-приложение удобно для рассылки расписаний, графиков, планов, т.д.
Появились вопросы или предложения? Оставьте комментарий ниже.
Для гарантии правильности ввода дат пользователями элемент управления Excel Календарь (Calendar) может упростить ситуацию как для вас, так и для пользователей, работающих с вашей электронной таблицей. При помощи этого трюка можно добавить элемент управления Календарь (Calendar) в любую рабочую книгу Excel.
Если дата введена неправильно, Excel не сможет ее распознать. Иногда это означает, что вы не можете выполнять вычисления с числами, выглядящими как даты, но датами не являющимися. Кроме того, это означает, что любые диаграммы или сводные таблицы, которые основываются на этих данных, будут неверными. Хотя решить эту проблему может весьма разностороннее средство проверки данных Excel, оно также далеко от совершенства.
При помощи этого трюка можно добавить элемент управления Календарь (Calendar) в любую рабочую книгу Excel. Для начала откройте рабочую книгу, куда собираетесь добавить календарь. Лучше использовать ваш файл Personal.xls, который можно открыть командой Файл → Открыть (File → Open). Если этот пункт меню недоступен, значит, у вас пока нет файла Personal.xls. Можно создать его, записав пустой макрос. Для этого выберите команду Разработчик → Начать запись (Developer → Record New Macro) и в поле Сохранить в (Store Macro In) выберите вариант Личная книга макросов (Personal Macro Workbook). Затем щелкните на кнопке ОК, выделите любую ячейку и остановите запись. Excel автоматически создаст файл Personal.xls.
Выберите команду Разработчик → Редактор Visual Basic (Developer → Visual Basic Editor) (сочетание клавиш Alt/Option+Fll) и в VBE выберите команду Insert → UserForm. Должна появиться панель инструментов Control. (Если панель не открылась, выберите команду View → Toolbox.) Правой кнопкой мыши щелкните панель инструментов Control и в контекстном меню выберите команду Additional Controls. Прокрутите список до флажка Элемент управления Календарь 10.0 (Calendar Control 10.0) (номер версии зависит от версии Excel). Установите этот флажок и щелкните на кнопке ОК. Щелкните календарь, который теперь представляет собой часть панели инструментов, а затем щелкните форму UserForm, которую добавили ранее. При помощи маркеров изменения размера формы UserForm и элемента управления Календарь (Calendar) отрегулируйте их размер.
Удостоверьтесь, что форма UserForm выделена, и выберите команду View → Properties Window (клавиша F4). В окне Properties выберите Caption и замените слово UserForml словом Calendar. Теперь выберите команду View → Code (клавиша F7) и в частном модуле введите код, приведенный в листинге 7.14.
1 2 3 4 5 6 7 8 |
//Листинг 7.14 Private Sub Calendar1_Click() ActiveCell = Calendar1.Value End Sub Private Sub UserForm_Activate() Me.Calendar1.Value = Date End Sub |
//Листинг 7.14 Private Sub Calendar1_Click() ActiveCell = Calendar1.Value End Sub Private Sub UserForm_Activate() Me.Calendar1.Value = Date End Sub
Выберите команду Insert → Module и в общем модуле введите код из листинга 7.15.
1 2 3 4 |
//Листинг 7.15 Sub ShowIt() UserForm1.Show End Sub |
//Листинг 7.15 Sub ShowIt() UserForm1.Show End Sub
Закройте окно, чтобы вернуться в Excel. Выберите команду Разработчик > Макрос → Макросы (Developer > Macro → Macros) (сочетание клавиш Alt+F8) и затем выберите ShowIt. Щелкните кнопку Параметры (Options) и назначьте макросу клавишное сочетание — все готово. Нажмите выбранное сочетание клавиш, раскроется календарь с выбранной сегодняшней датой. Щелкните любую дату, и она будет вставлена в активную ячейку.
Формат даты используется для отображения дат и времени, представленных числами, в виде дат. Система дат в Excel устроена так, что дату 01.01.1900 года приняли за отправную точку и обозначили числом 1, таким образом, любая дата представляет собой число дней, пройденных с 1 января 1900 года до этой даты. Значение времени является составной частью даты и хранится в виде десятичной дроби. Со значениями даты и времени можно производить математические действия, так как они являются числами.
Как задать формат даты в Excel 2007/2010?
Для задания формата даты необходимо выделить нужные ячейки, после чего перейти на вкладку «Главная», в группу «Число» и раскрыть список форматов в поле «Числовой формат».
В раскрывшемся списке доступны два числовых формата: «Краткая дата» и «Длинный формат даты». В первом случае дата отображается числами, а во втором — числами и словами. Если предложенные форматы не подходят, выбираем пункт «Другие числовые форматы…», в результате чего появляется окно «Формат ячеек».
Это окно также можно вызвать щелчком левой кнопки мыши на правый нижний уголок группы,
либо просто кликнуть правой кнопкой мыши в области выделенных ячеек и выбрать из контекстного меню пункт «Формат ячеек».
В появившемся окне «Формат ячеек» переходим на вкладку «Число» и в группе «Числовые форматы» выбираем пункт «Дата»
В правой части окна отображаются возможности данного формата, в группе «Тип» выбераем нужный способ отображения даты. Форматы даты, перед которыми стоит значок *(звездочка), зависят от даты операционной системы, форматы, перед которыми этого значка нет – не зависят.
Как задать свой собственный формат даты? Как преобразовать дату в год, месяц либо день недели?
Выделяем нужные ячейки в окне открытого листа и вызываем окно «Формат ячеек» любым из перечисленных выше способов. В окне «Формат ячеек» выбираем вкладку «Число» и в группе «Числовые форматы» выбираем пункт «Все форматы». После этого помещаем курсор в поле «Тип» и набираем код числового формата в русской раскладке клавиатуры:
— М – для отображения месяцев в виде числа от 1 до 12;
— ММ — для отображения месяцев в виде числа от 01 до 12;
— МММ – для отображения месяцев в виде «янв» — «дек»;
— ММММ — для отображения месяцев в виде «январь» — «декабрь»;
— МММММ – для отображения месяцев виде первой буквы месяца;
Форматы с кодом «М» можно использовать для преобразования даты в месяц.
— д – для отображения дней в виде числа от 1 до 31;
— дд – для отображения дней в виде числа от 01 до 31;
— ддд – для отображения дней в виде «Пн» — «Вс»;
— дддд – для отображения дней в виде «понедельник» — «воскресенье»;
Форматы с кодом «д» используются для преобразования даты в день.
— гг – для отображения лет в виде чисел от 00 до 99;
-гггг – для отображения лет в виде чисел от 1900 до 9999.
Форматы с кодом «г» используются для преобразования даты в год.
Как установить систему дат 1904?
Кроме вышеописанной системы дат, Excel поддерживает еще одну систему – 1904 года, которая используется на компьютерах Macintosh. Excel автоматически производит смену системы дат, но при необходимости, это можно сделать самостоятельно вручную. Для этого нажимаем кнопку «Office», выбираем кнопку «Параметры Excel», заходим в раздел «Дополнительно» и находим группу «При пересчете этой книги». Смена системы дат производится установкой/снятием флажка перед пунктом «Использовать систему дат 1904».
Как вводить дату в ячейку?
Для того, чтобы Excel воспринимал информацию, вводимую в ячейку, как дату, необходимо использовать в качестве разделителя точку, тире либо наклонную черту «/». При этом все введенные числа, меньшие 31.12, 31-12 либо 31/12 будут автоматически восприниматься как даты, а большие — как текст. Как уже говорилось выше, ячейки с датами могут использоваться в расчетах.
Для тех, кто активно работает с датами в своих таблицах, были созданы надстройки, представляющие собой календарь в Excel. Пример такой надстройки – календарь samradDatePicker. Скажем спасибо создателям этой надстройки и тем, кто доработал ее и перевел на русский язык! Надстройка упрощает ввод дат в ячейки листа Excel. После установки этой надстройки в контекстное меню (щелчок правой кнопки мыши) добавляется новый пункт «Выбрать из календаря», а при выделении ячеек, содержащих дату, справа от ячейки отображается значок календаря.
бесплатно скачать надстройку samradDatePicker для быстрого ввода дат
Как устанавливаются надстройки в Excel, уже описывалось в одной из статей на этом сайте, поэтому не буду повторяться. Добавлю лишь только, что Вы можете бесплатно скачать эту надстройку, а также ознакомиться с другими полезными надстройками для Excel.
Как вставить в ячейку статическую, фиксированную, не обновляемую дату?
Выделите в окне открытого листа ячейку, в которую требуется вставить текущую дату, и нажмите сочетание клавиш Ctrl+; (точка с запятой). При нажатии этого сочетания клавиш делается своего рода «снимок» с текущей даты и вставляется в ячейку. Введенная таким способом дата не изменяется с течением времени, а остается фиксированной.
Как вставить в ячейку текущую автоматически обновляемую дату?
Выберите нужную ячейку на листе Excel и введите в нее, как показано ниже, функцию «Сегодня», использующую значение системных часов компьютера.
Функцию можно вписать в ячейку вручную с клавиатуры, а можно воспользоваться мастером функций.
Другие материалы по теме:
Одним из распространенных способов использования Excel является создание списков событий, встреч и других мероприятий, связанных с календарем. В то время как Excel способен с легкостью обрабатывать эти данные, он не имеет быстрого способа визуализировать эту информацию. Нам потребуется немного творчества, условного форматирования, несколько формул и 3 строки кода VBA, чтобы создать симпатичный, интерактивный календарь. Рассмотрим, как можем все это реализовать.
Я нашел этот пример на сайте Chandoo.org и делюсь им с вами.
Интерактивный календарь в Excel
На выходе у нас должно получиться что-то вроде этого:
Создаем таблицу с событиями
На листе Расчеты создаем таблицу со всеми событиями
Настраиваем календарь
Так как все события происходят в рамках двух месяцев, я просто ввел первую дату первого месяца, протянул вниз и отформатировал так, чтобы было похоже на календарь. На данном этапе он должен выглядеть следующим образом.
Задаем имя диапазону дат в календаре
Это просто, выделяем весь диапазон дат нашего календаря и в поле Имя задаем «Календарь»
Определяем ячейку с выделенной датой
На листе Расчеты выбираем пустую ячейку и задаем ей имя «ВыделеннаяЯчейка». Мы будем использовать ее для определения даты, которую выбрал пользователь. В нашем случае, это ячейка G3.
Добавляем макрос на событие Worksheet_selectionchange()
Описанный ниже код поможет идентифицировать, когда пользователь выбрал ячейку в диапазоне “Календарь”. Добавьте этот код на лист с календарем. Для этого открываем редактор VBA, нажатием Alt+F11. Копируем код ниже и вставляем его Лист1.
|
1 |
Private Sub Worksheet_SelectionChange(ByVal Target As Range) |
Настраиваем формулы для отображения деталей при выборе даты
Изменение даты на календаре ведет за собой изменение 4-х параметров отображения в анонсе: название, дата, место и описание. Зная, что дата находится в ячейке «ВыделеннаяЯчейка», воспользуемся формулами ВПР, ЕСЛИ и ЕСЛИОШИБКА для определения этих параметров. Логика формул следующая: если на выбранную дату существует событие, возвращает данные этого события, иначе возвращает пустую ячейку. Формулы с определением параметров события находятся на листе Расчеты, в ячейках G10:G13.
Добавление анонса
Наконец добавляем в лист Календарь 4 элемента Надпись и привязываем их к данным, находящихся в ячейках G10:G13 листа Расчеты.
Совет: для того, чтобы привязать значение ячейки к элементу Надпись, просто выделите элемент, в строке формул наберите G10 и щелкните Enter.
Настраиваем условное форматирование для выделенной даты
Наконец, добавьте условное форматирование, чтобы выделить даты с событиями в календаре.
Выберите диапазон дат в календаре
Переходим на вкладке Главная в группу Стили –> Условное форматирование –> Создать правило
В диалоговом окне Создание правила форматирования, выберите тип правила Использовать формулу для определения форматируемых ячеек.
Задаем правила выделения как на рисунке
Форматируем
Подчищаем рабочий лист, форматируем наш календарь и получаем классную визуализацию.
Пример рабочей книги с интерактивным календарем.
Вставляем календарь на лист
К сожалению, в стандартной поставке Excel отсутствует надстройка «Календарь». И если вам приходится часто вводить разнообразные даты, и вы хотите делать это, выбирая их из календаря – у вас два выхода. Срочно заняться изучением VBA (Visual Basic for Applications), или воспользоваться готовой надстройкой, созданной другими пользователями. Благо в интернете их множество.
Могу посоветовать в качестве варианта Windows Date Picker от Ron de Bruin. Достаточно удобный, автоматически подхватывает национальные настройки отображения дат, встраивается в контекстное меню. Скачать его можно, зайдя на сайт автора.
Как установить надстройку Windows Date Picker в Excel 2007
Открываем параметры Excel и в разделе «Надстройки» внизу жмем на кнопку «Перейти»
В открывшемся окне нужно нажать на кнопку «Обзор» и указать путь к файлу WinDatePicker.xla, который вы распаковали из скачанного с сайта архива.
Теперь в меню правой кнопки у вас появился дополнительный пункт
Выбрав этот пункт, вы получите календарь, позволяющий выбирать и вставлять даты.
Как это сделать в Excel 2003
Добраться до надстроек можно через меню «Сервис»
А дальше все то же.
Покоряйте Excel и до новых встреч!
Some users may not have the ability to use your DatePicker if their Excel is not formatted correctly. I developed code that will create a dateGetter userform, get the user’s date selection as a Global variable, and then delete the form. It should be compatible with most systems, though I haven’t tested it on others than my own. Give it a shot. If it works for you, give me a shout out….
August 2020:
Fixed a glitch — when selecting the original date that opened with the form the returning date was «00:00:00 AM» — I fixed that below to return the date showing in the label2 caption.
Also — MSForms reference is necessary for the dateGetter() subroutine to work properly or you get an error message when the forms objects are declared. I’ve added another subroutine that can add that reference through VBA code, or in the VBA Editor goto «Tools —> References» and select the MSForms refwerence. You must do this before attempting to run the dateGetter macro.
Public absDate As Date ' This Public Variable is necessary to pass selected date
Sub setGUIDReferences()
' NOTE: The dateGetter() sub will not work until the MSForms Reference is added to this workbook project
' You can add the MSForms reference by running this sub first
' Or go to Tools --> References and select the MSForms reference there
' included below are several other common references you can use for other projects just uncomment them to add
' *************************************************************************************************************
On Error Resume Next
'ThisWorkbook.VBProject.References.AddFromGuid "{000204EF-0000-0000-C000-000000000046}", 0, 0 ' Visual Basic For Applications
'ThisWorkbook.VBProject.References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 0, 0 ' Microsoft Excel 16.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{00020430-0000-0000-C000-000000000046}", 0, 0 ' OLE Automation
'ThisWorkbook.VBProject.References.AddFromGuid "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", 0, 0 ' Microsoft Office 16.0 Object Library
ThisWorkbook.VBProject.References.AddFromGuid "{0D452EE1-E08F-101A-852E-02608C4D0BB4}", 0, 0 ' Microsoft Forms 2.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}", 0, 0 ' Microsoft HTML Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 0, 0 ' Microsoft Internet Controls
'ThisWorkbook.VBProject.References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 0, 0 ' Microsoft Scripting Runtime
'ThisWorkbook.VBProject.References.AddFromGuid "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}", 0, 0 ' Microsoft Windows Common Controls-2 6.0 (SP6)
'ThisWorkbook.VBProject.References.AddFromGuid "{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07}", 0, 0 ' Microsoft Access 16.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0 ' Microsoft Visual Basic for Applications Extensibility 5.3
'ThisWorkbook.VBProject.References.AddFromGuid "{F5078F18-C551-11D3-89B9-0000F81FE221}", 0, 0 ' Microsoft MSXML2 for XML Scraping
On Error GoTo 0
End Sub
Sub dateGetter()
' This creates dategetter userform for those without access to date picker
' Bug Fixed: Aug 2020, Selecting Original Date was resulting in 12:00:00 AM
'*********
' Note: MSForms Reference in Tools menu must be added to workbook first before this calendar script will work
' You can add several commonly used references by running the "setGUIDReferences()" subroutine above.
' Or go to Tools --> References and select the MSForms reference there
'*********
Dim myForm As Object, calendarForm As Object, newLabel As MSForms.Label, newSpinner As MSForms.SpinButton
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
Dim NewListBox As MSForms.ListBox
Dim smallDayArray
Dim xDiff As Long
Dim smallTextArray
Dim startDate As Date
Dim endDate As Date
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Create the User Form
With myForm
.Properties("Caption") = "Select Date Range"
.Properties("Width") = 247.5
.Properties("Height") = 350
End With
'create button
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
.Name = "CommandButton1"
.Top = 288
.Left = 138
.Width = 42
.Height = 24
.Font.Size = 10
.Font.Name = "Tahoma"
.Caption = "Cancel"
End With
'create button
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
.Name = "CommandButton2"
.Top = 288
.Left = 186
.Width = 42
.Height = 24
.Font.Size = 10
.Font.Name = "Tahoma"
.Caption = "Select"
End With
'create frame
Set NewFrame = myForm.designer.Controls.Add("Forms.frame.1")
With NewFrame
.Name = "Frame1"
.Top = 54
.Left = 24
.Width = 192
.Height = 180
.Font.Size = 9
.Font.Name = "Tahoma"
End With
'Create label1
Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
With newLabel
.Name = "Label1"
.Top = 30
.Left = 30
.Width = 102
.Height = 18
.Font.Size = 12
.Font.Name = "Tahoma"
.ForeColor = RGB(128, 0, 0)
.BackColor = RGB(256, 256, 256)
.Caption = "November 2017"
End With
'Create label2
Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
With newLabel
.Name = "Label2"
.Top = 258
.Left = 36
.Width = 174
.Height = 18
.Font.Size = 12
.Font.Name = "Tahoma"
.ForeColor = RGB(0, 0, 0)
.Caption = "01/01/2017"
End With
'Create SpinButton1
Set newSpinner = myForm.designer.Controls.Add("Forms.spinbutton.1")
With newSpinner
.Name = "SpinButton1"
.Top = 24
.Left = 144
.Width = 12.75
.Height = 25
End With
'Create Calendar Header Labels
smallDayArray = Array("S", "M", "T", "W", "T", "F", "S")
smallTextArray = Array("day1", "day2", "day3", "day4", "day5", "day6", "day7")
xDiff = 18
For i = LBound(smallDayArray) To UBound(smallDayArray)
Set lbl = NewFrame.Controls.Add("Forms.Label.1")
With lbl
.Name = smallTextArray(i)
.Top = 6
.Left = xDiff
.Width = 12
.Height = 18
.Font.Size = 11
.Font.Name = "Tahoma"
.Caption = smallDayArray(i)
End With
xDiff = xDiff + 24
Next i
'Create Calendar boxes labels
arrCounter = 1
For j = 1 To 6
xDiff = 12
For k = 1 To 7
Set lbl = NewFrame.Controls.Add("Forms.Label.1")
With lbl
.Name = "lb_" & arrCounter
Select Case j
Case 1
.Top = 24
Case 2
.Top = 48
Case 3
.Top = 72
Case 4
.Top = 96
Case 5
.Top = 120
Case 6
.Top = 144
End Select
.Left = xDiff
.Width = 18
.Height = 18
.Font.Size = 11
.Font.Name = "Tahoma"
.Caption = " " & arrCounter
.ForeColor = RGB(128, 0, 0)
.BackColor = RGB(256, 256, 256)
End With
arrCounter = arrCounter + 1
xDiff = xDiff + 24
Next k
Next j
''add code for form module
myForm.codemodule.insertlines 1, "Private Sub CommandButton1_Click()"
myForm.codemodule.insertlines 2, "absDate = 0"
myForm.codemodule.insertlines 3, "Unload Me"
myForm.codemodule.insertlines 4, "End Sub"
myForm.codemodule.insertlines 5, ""
myForm.codemodule.insertlines 6, "Private Sub SpinButton1_SpinDown()"
myForm.codemodule.insertlines 7, "Dim newDate1 As Date"
myForm.codemodule.insertlines 8, " newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
myForm.codemodule.insertlines 9, " newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", -1, newDate1)"
myForm.codemodule.insertlines 10, " Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
myForm.codemodule.insertlines 11, " Call clearBoxes"
myForm.codemodule.insertlines 12, " Run fillCal(newDate1)"
myForm.codemodule.insertlines 13, "End Sub"
myForm.codemodule.insertlines 14, "Private Sub SpinButton1_SpinUp()"
myForm.codemodule.insertlines 15, "Dim newDate1 As Date"
myForm.codemodule.insertlines 16, " newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
myForm.codemodule.insertlines 17, " newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", 1, newDate1)"
myForm.codemodule.insertlines 18, " Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
myForm.codemodule.insertlines 19, " Call clearBoxes"
myForm.codemodule.insertlines 20, " Run fillCal(newDate1)"
myForm.codemodule.insertlines 21, "End Sub"
myForm.codemodule.insertlines 22, "Function dhDaysInMonth2(Optional dtmDate As Date = 0) As Integer"
myForm.codemodule.insertlines 23, " ' Return the number of days in the specified month. Written by Chip Pierson"
myForm.codemodule.insertlines 24, " If dtmDate = 0 Then"
myForm.codemodule.insertlines 25, " ' Did the caller pass in a date? If not, use"
myForm.codemodule.insertlines 26, " ' the current date."
myForm.codemodule.insertlines 27, " dtmDate = Date"
myForm.codemodule.insertlines 28, " End If"
myForm.codemodule.insertlines 29, " dhDaysInMonth2 = DateSerial(Year(dtmDate), _ "
myForm.codemodule.insertlines 30, " Month(dtmDate) + 1, 1) - _ "
myForm.codemodule.insertlines 31, " DateSerial(Year(dtmDate), Month(dtmDate), 1)"
myForm.codemodule.insertlines 32, "End Function"
myForm.codemodule.insertlines 33, "Public Sub UserForm_Activate()"
myForm.codemodule.insertlines 34, "Dim currentDate As Date"
myForm.codemodule.insertlines 35, ""
myForm.codemodule.insertlines 36, " For i = 1 To 42" & vbNewLine
myForm.codemodule.insertlines 37, " txt = txt & " & Chr(34) & "Private Sub lb_" & Chr(34) & " & i & " & Chr(34) & "_Click()" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 38, " txt = txt & " & Chr(34) & "Dim newDate As Date" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 39, " txt = txt & " & Chr(34) & "newDate = DateValue(Mid(Label1.Caption, 1, Len(Label1.Caption) - 5) &" & Chr(34) & " & Chr(34) & " & Chr(34) & Chr(34) & " & lb_" & " & i & " & Chr(34) & ".Caption & " & Chr(34) & " & Chr(34) & " & Chr(34) & ", " & Chr(34) & " & Chr(34) & " & Chr(34) & " & Right(Label1.Caption, 4))" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 40, " txt = txt & " & Chr(34) & "Label2.Caption = " & Chr(34) & " & Chr(34) & " & Chr(34) & "Date: " & Chr(34) & " & Chr(34) & " & Chr(34) & " & newDate" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 41, "txt = txt & " & Chr(34) & "End Sub" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 42, "Next i" & vbNewLine
myForm.codemodule.insertlines 43, ""
myForm.codemodule.insertlines 44, "Label2.Caption = Chr(34) & Chr(34) "
myForm.codemodule.insertlines 45, "currentDate = DateValue(Month(Date) & " & Chr(34) & " 1" & Chr(34) & " & " & Chr(34) & ", " & Chr(34) & " & Year(Date))"
myForm.codemodule.insertlines 46, "Run fillCal(currentDate)"
myForm.codemodule.insertlines 47, "End Sub"
myForm.codemodule.insertlines 48, "Function fillCal(startDate As Date)"
myForm.codemodule.insertlines 49, "Dim currentDayOfMonth As Integer, i As Integer"
myForm.codemodule.insertlines 50, "currentDayOfMonth = Day(Date)"
myForm.codemodule.insertlines 51, "Dim startCal As Date, currentMonth as Integer"
myForm.codemodule.insertlines 52, "Dim labelArray, sumVar3 As Long"
myForm.codemodule.insertlines 53, " Label2.Caption = " & Chr(34) & "" & Chr(34)
myForm.codemodule.insertlines 54, " labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
& Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
& "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ", _"
myForm.codemodule.insertlines 55, " " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
myForm.codemodule.insertlines 56, " " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
myForm.codemodule.insertlines 57, " Label1 = MonthName(Month(startDate)) & " & Chr(34) & " " & Chr(34) & " & Year(startDate)"
myForm.codemodule.insertlines 58, " sumVar3 = Weekday(startDate) - 1"
myForm.codemodule.insertlines 59, " "
myForm.codemodule.insertlines 60, " For i = LBound(labelArray) To UBound(labelArray)"
myForm.codemodule.insertlines 61, " Me.Controls(labelArray(i)).Caption = " & Chr(34) & "" & Chr(34) & ""
myForm.codemodule.insertlines 62, " Next i"
myForm.codemodule.insertlines 63, " "
myForm.codemodule.insertlines 64, " For i = 1 To dhDaysInMonth2(startDate)"
myForm.codemodule.insertlines 65, " Me.Controls(labelArray(sumVar3)).Caption = i"
myForm.codemodule.insertlines 66, " If currentDayOfMonth = i And month(Date) = Month(StartDate) And Year(Date) = Year(StartDate) Then"
myForm.codemodule.insertlines 67, " Me.Controls(labelArray(sumVar3)).BackColor = RGB(256, 0, 0)"
myForm.codemodule.insertlines 68, " Me.Controls(labelArray(sumVar3)).ForeColor = RGB(256, 256, 256)"
myForm.codemodule.insertlines 69, " Label2.Caption = " & Chr(34) & "Date: " & Chr(34) & " & DateValue(Month(startDate) & " & Chr(34) & "/" & Chr(34) & " & i & " & Chr(34) & "/" & Chr(34) & " & Year(startDate))"
myForm.codemodule.insertlines 70, " End If"
myForm.codemodule.insertlines 71, " sumVar3 = sumVar3 + 1"
myForm.codemodule.insertlines 72, " Next i"
myForm.codemodule.insertlines 73, " "
myForm.codemodule.insertlines 74, "End Function"
myForm.codemodule.insertlines 75, "Private Sub CommandButton2_Click()"
myForm.codemodule.insertlines 76, " absDate = Replace(Me.Label2.Caption, " & Chr(34) & "Date: " & Chr(34) & ", " & Chr(34) & Chr(34) & "):Unload Me"
myForm.codemodule.insertlines 77, "End Sub"
myForm.codemodule.insertlines 78, "Private Sub clearBoxes()"
myForm.codemodule.insertlines 79, "Dim labelArray"
myForm.codemodule.insertlines 80, " Label2.Caption = " & Chr(34) & "" & Chr(34)
myForm.codemodule.insertlines 81, " labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
& Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
& "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ", _"
myForm.codemodule.insertlines 82, " " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
myForm.codemodule.insertlines 83, " " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
myForm.codemodule.insertlines 84, " For i = lbound(labelArray) to ubound(labelArray)"
myForm.codemodule.insertlines 85, " Me.Controls(labelArray(i)).BackColor = RGB(256, 256, 256)"
myForm.codemodule.insertlines 86, " Me.Controls(labelArray(i)).ForeColor = RGB(0, 0, 0)"
myForm.codemodule.insertlines 87, " next i"
myForm.codemodule.insertlines 88, "End Sub"
' add click controls for date label boxes
Dim myCounter As Long
myCounter = 89
For i = 1 To 42
myForm.codemodule.insertlines myCounter, "Private Sub lb_" & i & "_Click()"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Dim newDate As Date"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Call clearBoxes"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "absDate = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & Chr(32) & Chr(34) & " & lb_" & i & ".Caption & " & Chr(34) & ", " & Chr(34) & Chr(38) & " Right(Label1.Caption, 4))"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Label2.Caption = " & Chr(34) & "Date: " & Chr(34) & " & absDate" & vbNewLine
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "lb_" & i & ".backcolor = rgb(256,0,0)"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "lb_" & i & ".forecolor = rgb(256,256,256)"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "End Sub" & vbNewLine
myCounter = myCounter + 1
Next i
'Add and show new userform
absDate = Format(Date, "mm/dd/yyyy")
Set calendarForm = VBA.UserForms.Add(myForm.Name)
calendarForm.Show
If absDate <> 0 Then
' Here is where you put your code to to use the selected date
' whhich is in the global variabole "absDate"
startDate = absDate
Debug.Print "Your First Date is " & startDate
Else
Beep
MsgBox "You did not select a date"
GoTo endItAll
End If
endItAll:
' Uncomment the following line if you want to delete the form after using it
ThisWorkbook.VBProject.VBComponents.Remove myForm
End Sub
Function dhDaysInMonth(Optional dtmDate As Date = 0) As Integer
' Return the number of days in the specified month. Written by Chip Pierson
If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhDaysInMonth2 = DateSerial(Year(dtmDate), _
Month(dtmDate) + 1, 1) - _
DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function
Some users may not have the ability to use your DatePicker if their Excel is not formatted correctly. I developed code that will create a dateGetter userform, get the user’s date selection as a Global variable, and then delete the form. It should be compatible with most systems, though I haven’t tested it on others than my own. Give it a shot. If it works for you, give me a shout out….
August 2020:
Fixed a glitch — when selecting the original date that opened with the form the returning date was «00:00:00 AM» — I fixed that below to return the date showing in the label2 caption.
Also — MSForms reference is necessary for the dateGetter() subroutine to work properly or you get an error message when the forms objects are declared. I’ve added another subroutine that can add that reference through VBA code, or in the VBA Editor goto «Tools —> References» and select the MSForms refwerence. You must do this before attempting to run the dateGetter macro.
Public absDate As Date ' This Public Variable is necessary to pass selected date
Sub setGUIDReferences()
' NOTE: The dateGetter() sub will not work until the MSForms Reference is added to this workbook project
' You can add the MSForms reference by running this sub first
' Or go to Tools --> References and select the MSForms reference there
' included below are several other common references you can use for other projects just uncomment them to add
' *************************************************************************************************************
On Error Resume Next
'ThisWorkbook.VBProject.References.AddFromGuid "{000204EF-0000-0000-C000-000000000046}", 0, 0 ' Visual Basic For Applications
'ThisWorkbook.VBProject.References.AddFromGuid "{00020813-0000-0000-C000-000000000046}", 0, 0 ' Microsoft Excel 16.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{00020430-0000-0000-C000-000000000046}", 0, 0 ' OLE Automation
'ThisWorkbook.VBProject.References.AddFromGuid "{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52}", 0, 0 ' Microsoft Office 16.0 Object Library
ThisWorkbook.VBProject.References.AddFromGuid "{0D452EE1-E08F-101A-852E-02608C4D0BB4}", 0, 0 ' Microsoft Forms 2.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{3050F1C5-98B5-11CF-BB82-00AA00BDCE0B}", 0, 0 ' Microsoft HTML Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}", 0, 0 ' Microsoft Internet Controls
'ThisWorkbook.VBProject.References.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 0, 0 ' Microsoft Scripting Runtime
'ThisWorkbook.VBProject.References.AddFromGuid "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}", 0, 0 ' Microsoft Windows Common Controls-2 6.0 (SP6)
'ThisWorkbook.VBProject.References.AddFromGuid "{4AFFC9A0-5F99-101B-AF4E-00AA003F0F07}", 0, 0 ' Microsoft Access 16.0 Object Library
'ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0 ' Microsoft Visual Basic for Applications Extensibility 5.3
'ThisWorkbook.VBProject.References.AddFromGuid "{F5078F18-C551-11D3-89B9-0000F81FE221}", 0, 0 ' Microsoft MSXML2 for XML Scraping
On Error GoTo 0
End Sub
Sub dateGetter()
' This creates dategetter userform for those without access to date picker
' Bug Fixed: Aug 2020, Selecting Original Date was resulting in 12:00:00 AM
'*********
' Note: MSForms Reference in Tools menu must be added to workbook first before this calendar script will work
' You can add several commonly used references by running the "setGUIDReferences()" subroutine above.
' Or go to Tools --> References and select the MSForms reference there
'*********
Dim myForm As Object, calendarForm As Object, newLabel As MSForms.Label, newSpinner As MSForms.SpinButton
Dim NewFrame As MSForms.Frame
Dim NewButton As MSForms.CommandButton, newButton2 As MSForms.CommandButton
Dim NewListBox As MSForms.ListBox
Dim smallDayArray
Dim xDiff As Long
Dim smallTextArray
Dim startDate As Date
Dim endDate As Date
Set myForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Create the User Form
With myForm
.Properties("Caption") = "Select Date Range"
.Properties("Width") = 247.5
.Properties("Height") = 350
End With
'create button
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
.Name = "CommandButton1"
.Top = 288
.Left = 138
.Width = 42
.Height = 24
.Font.Size = 10
.Font.Name = "Tahoma"
.Caption = "Cancel"
End With
'create button
Set NewButton = myForm.designer.Controls.Add("Forms.commandbutton.1")
With NewButton
.Name = "CommandButton2"
.Top = 288
.Left = 186
.Width = 42
.Height = 24
.Font.Size = 10
.Font.Name = "Tahoma"
.Caption = "Select"
End With
'create frame
Set NewFrame = myForm.designer.Controls.Add("Forms.frame.1")
With NewFrame
.Name = "Frame1"
.Top = 54
.Left = 24
.Width = 192
.Height = 180
.Font.Size = 9
.Font.Name = "Tahoma"
End With
'Create label1
Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
With newLabel
.Name = "Label1"
.Top = 30
.Left = 30
.Width = 102
.Height = 18
.Font.Size = 12
.Font.Name = "Tahoma"
.ForeColor = RGB(128, 0, 0)
.BackColor = RGB(256, 256, 256)
.Caption = "November 2017"
End With
'Create label2
Set newLabel = myForm.designer.Controls.Add("Forms.Label.1")
With newLabel
.Name = "Label2"
.Top = 258
.Left = 36
.Width = 174
.Height = 18
.Font.Size = 12
.Font.Name = "Tahoma"
.ForeColor = RGB(0, 0, 0)
.Caption = "01/01/2017"
End With
'Create SpinButton1
Set newSpinner = myForm.designer.Controls.Add("Forms.spinbutton.1")
With newSpinner
.Name = "SpinButton1"
.Top = 24
.Left = 144
.Width = 12.75
.Height = 25
End With
'Create Calendar Header Labels
smallDayArray = Array("S", "M", "T", "W", "T", "F", "S")
smallTextArray = Array("day1", "day2", "day3", "day4", "day5", "day6", "day7")
xDiff = 18
For i = LBound(smallDayArray) To UBound(smallDayArray)
Set lbl = NewFrame.Controls.Add("Forms.Label.1")
With lbl
.Name = smallTextArray(i)
.Top = 6
.Left = xDiff
.Width = 12
.Height = 18
.Font.Size = 11
.Font.Name = "Tahoma"
.Caption = smallDayArray(i)
End With
xDiff = xDiff + 24
Next i
'Create Calendar boxes labels
arrCounter = 1
For j = 1 To 6
xDiff = 12
For k = 1 To 7
Set lbl = NewFrame.Controls.Add("Forms.Label.1")
With lbl
.Name = "lb_" & arrCounter
Select Case j
Case 1
.Top = 24
Case 2
.Top = 48
Case 3
.Top = 72
Case 4
.Top = 96
Case 5
.Top = 120
Case 6
.Top = 144
End Select
.Left = xDiff
.Width = 18
.Height = 18
.Font.Size = 11
.Font.Name = "Tahoma"
.Caption = " " & arrCounter
.ForeColor = RGB(128, 0, 0)
.BackColor = RGB(256, 256, 256)
End With
arrCounter = arrCounter + 1
xDiff = xDiff + 24
Next k
Next j
''add code for form module
myForm.codemodule.insertlines 1, "Private Sub CommandButton1_Click()"
myForm.codemodule.insertlines 2, "absDate = 0"
myForm.codemodule.insertlines 3, "Unload Me"
myForm.codemodule.insertlines 4, "End Sub"
myForm.codemodule.insertlines 5, ""
myForm.codemodule.insertlines 6, "Private Sub SpinButton1_SpinDown()"
myForm.codemodule.insertlines 7, "Dim newDate1 As Date"
myForm.codemodule.insertlines 8, " newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
myForm.codemodule.insertlines 9, " newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", -1, newDate1)"
myForm.codemodule.insertlines 10, " Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
myForm.codemodule.insertlines 11, " Call clearBoxes"
myForm.codemodule.insertlines 12, " Run fillCal(newDate1)"
myForm.codemodule.insertlines 13, "End Sub"
myForm.codemodule.insertlines 14, "Private Sub SpinButton1_SpinUp()"
myForm.codemodule.insertlines 15, "Dim newDate1 As Date"
myForm.codemodule.insertlines 16, " newDate1 = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & " 1, " & Chr(34) & " & Right(Label1.Caption, 4))"
myForm.codemodule.insertlines 17, " newDate1 = DateAdd(" & Chr(34) & "m" & Chr(34) & ", 1, newDate1)"
myForm.codemodule.insertlines 18, " Label1.Caption = MonthName(Month(newDate1)) & " & Chr(34) & " " & Chr(34) & " & Year(newDate1)"
myForm.codemodule.insertlines 19, " Call clearBoxes"
myForm.codemodule.insertlines 20, " Run fillCal(newDate1)"
myForm.codemodule.insertlines 21, "End Sub"
myForm.codemodule.insertlines 22, "Function dhDaysInMonth2(Optional dtmDate As Date = 0) As Integer"
myForm.codemodule.insertlines 23, " ' Return the number of days in the specified month. Written by Chip Pierson"
myForm.codemodule.insertlines 24, " If dtmDate = 0 Then"
myForm.codemodule.insertlines 25, " ' Did the caller pass in a date? If not, use"
myForm.codemodule.insertlines 26, " ' the current date."
myForm.codemodule.insertlines 27, " dtmDate = Date"
myForm.codemodule.insertlines 28, " End If"
myForm.codemodule.insertlines 29, " dhDaysInMonth2 = DateSerial(Year(dtmDate), _ "
myForm.codemodule.insertlines 30, " Month(dtmDate) + 1, 1) - _ "
myForm.codemodule.insertlines 31, " DateSerial(Year(dtmDate), Month(dtmDate), 1)"
myForm.codemodule.insertlines 32, "End Function"
myForm.codemodule.insertlines 33, "Public Sub UserForm_Activate()"
myForm.codemodule.insertlines 34, "Dim currentDate As Date"
myForm.codemodule.insertlines 35, ""
myForm.codemodule.insertlines 36, " For i = 1 To 42" & vbNewLine
myForm.codemodule.insertlines 37, " txt = txt & " & Chr(34) & "Private Sub lb_" & Chr(34) & " & i & " & Chr(34) & "_Click()" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 38, " txt = txt & " & Chr(34) & "Dim newDate As Date" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 39, " txt = txt & " & Chr(34) & "newDate = DateValue(Mid(Label1.Caption, 1, Len(Label1.Caption) - 5) &" & Chr(34) & " & Chr(34) & " & Chr(34) & Chr(34) & " & lb_" & " & i & " & Chr(34) & ".Caption & " & Chr(34) & " & Chr(34) & " & Chr(34) & ", " & Chr(34) & " & Chr(34) & " & Chr(34) & " & Right(Label1.Caption, 4))" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 40, " txt = txt & " & Chr(34) & "Label2.Caption = " & Chr(34) & " & Chr(34) & " & Chr(34) & "Date: " & Chr(34) & " & Chr(34) & " & Chr(34) & " & newDate" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 41, "txt = txt & " & Chr(34) & "End Sub" & Chr(34) & " & vbNewLine" & vbNewLine
myForm.codemodule.insertlines 42, "Next i" & vbNewLine
myForm.codemodule.insertlines 43, ""
myForm.codemodule.insertlines 44, "Label2.Caption = Chr(34) & Chr(34) "
myForm.codemodule.insertlines 45, "currentDate = DateValue(Month(Date) & " & Chr(34) & " 1" & Chr(34) & " & " & Chr(34) & ", " & Chr(34) & " & Year(Date))"
myForm.codemodule.insertlines 46, "Run fillCal(currentDate)"
myForm.codemodule.insertlines 47, "End Sub"
myForm.codemodule.insertlines 48, "Function fillCal(startDate As Date)"
myForm.codemodule.insertlines 49, "Dim currentDayOfMonth As Integer, i As Integer"
myForm.codemodule.insertlines 50, "currentDayOfMonth = Day(Date)"
myForm.codemodule.insertlines 51, "Dim startCal As Date, currentMonth as Integer"
myForm.codemodule.insertlines 52, "Dim labelArray, sumVar3 As Long"
myForm.codemodule.insertlines 53, " Label2.Caption = " & Chr(34) & "" & Chr(34)
myForm.codemodule.insertlines 54, " labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
& Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
& "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ", _"
myForm.codemodule.insertlines 55, " " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
myForm.codemodule.insertlines 56, " " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
myForm.codemodule.insertlines 57, " Label1 = MonthName(Month(startDate)) & " & Chr(34) & " " & Chr(34) & " & Year(startDate)"
myForm.codemodule.insertlines 58, " sumVar3 = Weekday(startDate) - 1"
myForm.codemodule.insertlines 59, " "
myForm.codemodule.insertlines 60, " For i = LBound(labelArray) To UBound(labelArray)"
myForm.codemodule.insertlines 61, " Me.Controls(labelArray(i)).Caption = " & Chr(34) & "" & Chr(34) & ""
myForm.codemodule.insertlines 62, " Next i"
myForm.codemodule.insertlines 63, " "
myForm.codemodule.insertlines 64, " For i = 1 To dhDaysInMonth2(startDate)"
myForm.codemodule.insertlines 65, " Me.Controls(labelArray(sumVar3)).Caption = i"
myForm.codemodule.insertlines 66, " If currentDayOfMonth = i And month(Date) = Month(StartDate) And Year(Date) = Year(StartDate) Then"
myForm.codemodule.insertlines 67, " Me.Controls(labelArray(sumVar3)).BackColor = RGB(256, 0, 0)"
myForm.codemodule.insertlines 68, " Me.Controls(labelArray(sumVar3)).ForeColor = RGB(256, 256, 256)"
myForm.codemodule.insertlines 69, " Label2.Caption = " & Chr(34) & "Date: " & Chr(34) & " & DateValue(Month(startDate) & " & Chr(34) & "/" & Chr(34) & " & i & " & Chr(34) & "/" & Chr(34) & " & Year(startDate))"
myForm.codemodule.insertlines 70, " End If"
myForm.codemodule.insertlines 71, " sumVar3 = sumVar3 + 1"
myForm.codemodule.insertlines 72, " Next i"
myForm.codemodule.insertlines 73, " "
myForm.codemodule.insertlines 74, "End Function"
myForm.codemodule.insertlines 75, "Private Sub CommandButton2_Click()"
myForm.codemodule.insertlines 76, " absDate = Replace(Me.Label2.Caption, " & Chr(34) & "Date: " & Chr(34) & ", " & Chr(34) & Chr(34) & "):Unload Me"
myForm.codemodule.insertlines 77, "End Sub"
myForm.codemodule.insertlines 78, "Private Sub clearBoxes()"
myForm.codemodule.insertlines 79, "Dim labelArray"
myForm.codemodule.insertlines 80, " Label2.Caption = " & Chr(34) & "" & Chr(34)
myForm.codemodule.insertlines 81, " labelArray = Array(" & Chr(34) & "lb_1" & Chr(34) & ", " & Chr(34) & "lb_2" & Chr(34) & ", " & Chr(34) & "lb_3" & Chr(34) & ", " & Chr(34) & "lb_4" & Chr(34) & ", " & Chr(34) & "lb_5" _
& Chr(34) & ", " & Chr(34) & "lb_6" & Chr(34) & ", " & Chr(34) & "lb_7" & Chr(34) & ", " & Chr(34) & "lb_8" & Chr(34) & ", " & Chr(34) & "lb_9" & Chr(34) & ", " & Chr(34) _
& "lb_10" & Chr(34) & ", " & Chr(34) & "lb_11" & Chr(34) & ", " & Chr(34) & "lb_12" & Chr(34) & ", " & Chr(34) & "lb_13" & Chr(34) & ", " & Chr(34) & "lb_14" & Chr(34) & ", " & Chr(34) & "lb_15" & Chr(34) & ", _"
myForm.codemodule.insertlines 82, " " & Chr(34) & "lb_16" & Chr(34) & ", " & Chr(34) & "lb_17" & Chr(34) & ", " & Chr(34) & "lb_18" & Chr(34) & ", " & Chr(34) & "lb_19" & Chr(34) & ", " & Chr(34) & "lb_20" & Chr(34) & ", " & _
Chr(34) & "lb_21" & Chr(34) & ", " & Chr(34) & "lb_22" & Chr(34) & ", " & Chr(34) & "lb_23" & Chr(34) & ", " & Chr(34) & "lb_24" & Chr(34) & ", " & Chr(34) & "lb_25" & Chr(34) & ", " & _
Chr(34) & "lb_26" & Chr(34) & ", " & Chr(34) & "lb_27" & Chr(34) & ", " & Chr(34) & "lb_28" & Chr(34) & ", " & Chr(34) & "lb_29" & Chr(34) & ", " & Chr(34) & "lb_30" & Chr(34) & ", " & Chr(34) & "lb_31" & Chr(34) & ", _"
myForm.codemodule.insertlines 83, " " & Chr(34) & "lb_32" & Chr(34) & ", " & Chr(34) & "lb_33" & Chr(34) & ", " & Chr(34) & "lb_34" & Chr(34) & ", " & Chr(34) & "lb_35" & Chr(34) & ", " & Chr(34) & "lb_36" & Chr(34) & ", " & _
Chr(34) & "lb_37" & Chr(34) & ", " & Chr(34) & "lb_38" & Chr(34) & ", " & Chr(34) & "lb_39" & Chr(34) & ", " & Chr(34) & "lb_40" & Chr(34) & ", " & Chr(34) & "lb_41" & Chr(34) & ", " & Chr(34) & "lb_42" & Chr(34) & ")"
myForm.codemodule.insertlines 84, " For i = lbound(labelArray) to ubound(labelArray)"
myForm.codemodule.insertlines 85, " Me.Controls(labelArray(i)).BackColor = RGB(256, 256, 256)"
myForm.codemodule.insertlines 86, " Me.Controls(labelArray(i)).ForeColor = RGB(0, 0, 0)"
myForm.codemodule.insertlines 87, " next i"
myForm.codemodule.insertlines 88, "End Sub"
' add click controls for date label boxes
Dim myCounter As Long
myCounter = 89
For i = 1 To 42
myForm.codemodule.insertlines myCounter, "Private Sub lb_" & i & "_Click()"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Dim newDate As Date"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Call clearBoxes"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "absDate = DateValue(Left(Label1.Caption, Len(Label1.Caption) - 5) & " & Chr(34) & Chr(32) & Chr(34) & " & lb_" & i & ".Caption & " & Chr(34) & ", " & Chr(34) & Chr(38) & " Right(Label1.Caption, 4))"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "Label2.Caption = " & Chr(34) & "Date: " & Chr(34) & " & absDate" & vbNewLine
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "lb_" & i & ".backcolor = rgb(256,0,0)"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "lb_" & i & ".forecolor = rgb(256,256,256)"
myCounter = myCounter + 1
myForm.codemodule.insertlines myCounter, "End Sub" & vbNewLine
myCounter = myCounter + 1
Next i
'Add and show new userform
absDate = Format(Date, "mm/dd/yyyy")
Set calendarForm = VBA.UserForms.Add(myForm.Name)
calendarForm.Show
If absDate <> 0 Then
' Here is where you put your code to to use the selected date
' whhich is in the global variabole "absDate"
startDate = absDate
Debug.Print "Your First Date is " & startDate
Else
Beep
MsgBox "You did not select a date"
GoTo endItAll
End If
endItAll:
' Uncomment the following line if you want to delete the form after using it
ThisWorkbook.VBProject.VBComponents.Remove myForm
End Sub
Function dhDaysInMonth(Optional dtmDate As Date = 0) As Integer
' Return the number of days in the specified month. Written by Chip Pierson
If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhDaysInMonth2 = DateSerial(Year(dtmDate), _
Month(dtmDate) + 1, 1) - _
DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function