Изменение даты «Выполнить до»

Как и в статье «Выбираем дату формирования задач, на главной странице, используя календарь» сделаем удобный и функциональный календарь для удобного выбора даты во вкладках «Проекты», «Отложенное», «Периодическое».

Добиться необходимо следующего:

Полностью реализованный вариант выглядит так:

выбор даты «выполнить до»
выбор даты «выполнить до» на календаре

Как это сделать? Для начала создадим следующую пользовательскую форму:

выбор даты на календаре
форма выбора даты «Выполнить до»

Также как и в статье Выбираем дату формирования задач, на главной странице, используя календарь» воспользовавшись функцией calendar из Module1 сформируем календарь, а также возможность его листания как влево, так и вправо используя кнопки «<», «>».

При нажатии кнопки «Закрыть» выполняется макрос закрывающий форму:

' кнопка закрыть
Private Sub CommandButton5_Click()
' закрыть форму
Unload UserForm1
End Sub

Нажимая кнопку «Удалить дату» выполняется макрос удаляющий данные из активной ячейки:

' кнопка "Удалить дату"
Private Sub CommandButton3_Click()
' изменяем активную ячейку, удаляе из нее данные и выравнивая текс справа
With Cells(ActiveCell.Row, ActiveCell.Column)
.FormulaR1C1 = ""
.HorizontalAlignment = xlRight
End With

' закрываем форму
Unload UserForm1
End Sub

Ну и при выборе даты – записываем ее в активную ячейку и закрываем форму, используя функцию Set_On_Off:

' выбор даты на календаре
Function Set_On_Off(mylabel, i2 As Integer, j2 As Integer, n As Byte)
' если выбирается дата, не имеющая числа, выходим из функции
If UserForm1.Controls(mylabel & "_" & i2 & "_" & j2).Caption <> True Or UserForm1.Controls(mylabel & "_" & i2 & "_" & j2).Caption <= 0 Then Exit Function

' Очистить все ячейки
For i = 1 To 6
For j = 1 To 7
With UserForm1.Controls("p_" & i & "_" & j)
.BackColor = RGB(255, 255, 255)
.BorderColor = RGB(255, 255, 255)
.ForeColor = RGB(0, 0, 0)
End With
With UserForm1.Controls("t_" & i & "_" & j)
.BackColor = RGB(255, 255, 255)
.BorderColor = RGB(255, 255, 255)
.ForeColor = RGB(0, 0, 0)
End With
With UserForm1.Controls("n_" & i & "_" & j)
.BackColor = RGB(255, 255, 255)
.BorderColor = RGB(255, 255, 255)
.ForeColor = RGB(0, 0, 0)
End With
Next j
Next i

' Выделить текущую ячейку
With UserForm1.Controls(mylabel & "_" & i2 & "_" & j2)
.BackColor = RGB(204, 255, 204)
.BorderColor = RGB(150, 150, 150)
.ForeColor = RGB(0, 0, 0)
End With

' получаем выбранную дату и записываем ее в активную ячейку, предварительно приобразовав его в дату
With Cells(ActiveCell.Row, ActiveCell.Column)
.FormulaR1C1 = CDate(Format(UserForm1.Controls(mylabel & "_" & i2 & "_" & j2).Caption & " " & UserForm1.Controls(mylabel & "Month").Caption, "dd.mm.yyyy"))
.HorizontalAlignment = xlRight
End With

' закрываем форму
Unload UserForm1
End Function

Добавляем в процедуру Worksheet_SelectionChange(ByVal Target As Range) код, выполняемый при выполнении условий:

Только при соблюдении этих требований появляется пользовательская форма, в которую предварительно записываются данные: наименование задача (подзадачи), дата до которой ее необходимо выполнить.

' инициализация календаря при нажатии на дату "Выполнить до"
If Cells(ActiveCell.Row, ActiveCell.Column).Font.Strikethrough = False And (Len(Range("B" & ActiveCell.Row)) > 0 Or Len(Range("D" & ActiveCell.Row)) > 0) And ActiveCell.Column = 5 Then
' записываем данные в форму
With UserForm1
' получаем значение задачи
znach = Range("B" & ActiveCell.Row)
' если длина значения = 0, значит имеем дело с подзадачей. Получаем значение подзадачи
If Len(Range("B" & ActiveCell.Row)) <= 0 Then znach = Range("D" & ActiveCell.Row)
' записываем наименование задачи (подзадачи) на форму
.Label2.Caption = znach
' записываем дату задачи (подзадачи) на форму
.Label4.Caption = "Изменить дату выполнения с " & Cells(ActiveCell.Row, ActiveCell.Column) & " на"
End With
' закрываем форму
UserForm1.Show
' убираем курсор с даты
Cells(ActiveCell.Row, ActiveCell.Column - 4).Select
End If

Аналогичный код добавляем в процедуру Worksheet_SelectionChange(ByVal Target As Range) каждого листа Планеро.

Скачать актуальную версию Планеро.

Поделись с друзьями:
Комментарии 2

© планеро.ru