Выпадающий календарь - доработать под задачу

[Uralmaster]

Есть очень хороший выпадающий календарь - хотелось бы его доработать под следующую задачу:
Календарь вводит дату и время в одну ячейку а надо чтоб вводил дату в одну ячейку а время во 2 ячейку справа - как в примере (прилагаю файл)
Например Дата в G:11 Время H:11 - Дата в G:12 Время H:12 и тд

При этом ввод времени в форме календаря переделать в виде выпадающего списка (поля и кнопки установки времени убрать) – для времени остается одно поле с выпадающим списком
Выпадающий список - с листа «Время» в приложенном файле.

Календарь нужно привязать к вводу только в диапазон G10:H500
Причем в столбец G вводим дату, в столбец H – время

Впоследствие путем сортировки на даты – а потом сортировки на время внутри даты получается план на день с утра

[kuklp]

Вам уже ответили на Планете. Давайте поскромней. И хоть что-нибудь попытайтесь сделать сами. Эти форумы не авторешалка. Здесь помогают сделать что-то, а не делают все за Вас, по Вашему приказу.

[VictorM]

Открываете код формы календаря. находите вот это:

Private Sub Cmd_Select_Click()
    'Команда - закончить выбор даты и закрыть форму
'    SelectedDate = CStr(DateValue(dt_1))
    If sh = True Then ActiveCell = dt_1 Else ActiveCell = CStr(Format(DateValue(dt_1), "dd.mm.yyyy"))
'    Unload Me
End Sub

Пишете вместо выделенного красным, куда Вы хотите поместить дату.
С временем аналогично.

[Uralmaster]

Да нет никаких приказов - я пытаюсь подробно расписать что надо чтоб 10 раз потом вопросы не задавать тк часто беспокоить Вас тоже не резон. Свою задачу на 70 проц решаю сам а вопросы задаю чтоб на этапах сильно не застревать вот и все Формулировки может неправильно написал и тон не понравился - ладно поменяем ...сорри А решения выкладываемые на Вашем форуме сильно помогают же не только мне но и всем участникам

[Uralmaster]

Реализовал задачу
Файл во вложении
Только одна проблема осталась - календарь при запуске из ячейки диапазона дает старую дату а не сегодняшнюю
По кнопке макроса - дает сегодняшнюю дату

Как исправить ?



Что поправил (если кому интересно)

Привязка данных формы (списка) к диапазону ячеек

Вызываем форму встаем в окно на вкладке Categorized находим значение RowSourse
Делаем равным например =Этапы!C2:C28


Привязка вызова формы к диапазону ячеек

В лист вписать

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("G8:G80 1"), Target) Is Nothing Then
UserForm_Time.Show
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("F8:F80 1"), Target) Is Nothing Then
Form_SelectDate.Show
End If
End Sub



Вставка времени из формы Time в смещеную вправо ячейку (в форму Календаря)

If sh = True Then ActiveCell = dt_1 Else ActiveCell = CStr(Format(DateValue(dt_1), "dd.mm.yyyy"))
Form_SelectDate.Hide
ActiveCell.Offset(0, 1).Select

Форматирование ячеек по форме - В форму Time вписать

Private Sub ComboBox1_Click()
'Private Sub CommandButton1_Click()
ComboBox1.Value = Format(ComboBox1.Value, "h:mm")
ActiveCell = ComboBox1.Value
Unload UserForm_Time
End Sub

[kuklp]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("G8:G801"), Target) Is Nothing Then
UserForm_Time.Show
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("F8:F801"), Target) Is Nothing Then
Call Календарь
End If
End Sub

[Uralmaster]

Заработало благодарю за поддержку!!
Единственная мелочь - если ставлю календарь в место где есть дата то он сегодняшнюю не выводит - выводит старую .. если несложно где это поравить подскажите

[kuklp]

Sub Календарь()
    On Error GoTo err1
'    If ActiveCell = "" Then
        dt_1 = Format(Now(), "dd.mm.yy") & " 8:00"
'    Else
'        dt_1 = ActiveCell
'    End If
    dt_3 = ActiveCell
    sh = False
    Form_SelectDate.Show
    If dt_1 = dt_3 Then Exit Sub
    '   Selection.Value = dt_1

    Exit Sub
err1:
End Sub

[Uralmaster]

Работает железобетонно СЭНКС ...