Создание новой задачи с главной страницы

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

А что если на главной странице сделать кнопку «Добавить задачу» с возможностью автоматического размещения введенной задачи на соответствующем листе Планеро?

В общем, должно выглядеть так:

Добавляем новые задачи с главной страницы
Макрос добавления новых задач с главной страницы

А теперь обо всем по порядку. И для начала добавим кнопку «Добавить новую задачу» на главную страницу, применив к ней условное форматирование.

После создадим пользовательскую форму UserForm3, которая будет появляться при нажатии на кнопку «Добавить новую задачу», и разместим на ней следующие элементы:

Пользовательская форма
Форма для добавления новой задачи

Добавим в процедуру Private Sub Worksheet_SelectionChange(ByVal Target As Range) главной страницы следующий код, выполняемый при нажатии на кнопку «Добавить новую задачу»:

' Добавить новую задачу
If ActiveCell.Column = 8 And ActiveCell.Row = 2 And Cells(ActiveCell.Row, ActiveCell.Column) = "Добавить новую задачу" Then
' приводим пользовательскую форму к значению "по умолчанию"
Module1.uf3_def
' показываем форму
UserForm3.Show
' убираем курсор с формы
Workbooks("planero.xlsm").Worksheets("Главная").Range("A10").Select
End If

До вызова формы, выполняется функция uf3_def из Module1, которая приводит элементы, расположенные на пользовательской форме к значению «по умолчанию», т.е. убирает все ранее введенные данные, скрывает лишние кнопки и поля:

' форма "добавить новую задачу" по умолчанию
Function uf3_def()
' скрываем лишнее и показываем нужное
With UserForm3
.Height = 145
.Width = 550

.CommandButton1.Visible = True
.CommandButton2.Visible = True
.CommandButton3.Visible = True
.CommandButton4.Visible = True
.CommandButton5.Visible = False
.CommandButton6.Visible = False
.CommandButton8.Visible = False
.CommandButton9.Visible = False

.Label1.Visible = True
.Label2.Visible = True
.Label3.Visible = True
.Label4.Visible = True
.Label5.Visible = True
.Label11.Visible = False
.Label18.Visible = False
.Label19.Visible = False
.Label20.Visible = False
.Label21.Visible = False
.Label22.Visible = False
.Label23.Visible = False

With .Frame1
.Visible = False
.TextBox1.Value = ""
.TextBox2.Value = ""
.TextBox3.Value = ""
.TextBox4.Value = ""
.TextBox5.Value = ""
End With

.Frame2.Visible = False
End With

' выравниваем форму по центру окна excel
UserForm3.Top = (Application.Height - UserForm3.Height) / 2
UserForm3.Left = (Application.Width - UserForm3.Width) / 2
End Function

После, при нажатии на кнопку, появляется форма следующего вида:

Всплывающая форма «по умолчанию»

Создадим процедуры, реагирующие на нажатие соответствующей кнопки:

' кнопка "Входящие"
Private Sub CommandButton1_Click()
Module1.uf3_vh ("Добавить задачу во входящие")
End Sub

' кнопка "Проект"
Private Sub CommandButton2_Click()
Module1.uf3_vh ("Создать проект")
End Sub

' кнопка "Периодическая задача"
Private Sub CommandButton3_Click()
Module1.uf3_vh ("Добавить задачу в периодическое")
End Sub

' кнопка "Отложенная задача"
Private Sub CommandButton4_Click()
Module1.uf3_vh ("Добавить задачу в отложенные")
End Sub

И напишем саму функцию uf3_vh в Module1, которая и будет изменять форму и положение элементов на ней, в зависимости от выбора пользователя:

' форма "добавить новую задачу" - входящие, отложенные, периодические, проект
Function uf3_vh(tip)
With UserForm3
.Height = 184
.CommandButton1.Visible = False
.CommandButton2.Visible = False
.CommandButton3.Visible = False
.CommandButton4.Visible = False
With .CommandButton5
.Visible = True
.Top = 126
End With
With .CommandButton6
.Visible = True
.Top = 126
End With

.Label1.Visible = False
.Label2.Visible = False
.Label3.Visible = False
.Label4.Visible = False
.Label5.Visible = False
With .Frame1
.Caption = tip
.Visible = True
.TextBox1.Value = ""
.TextBox2.Value = ""
.TextBox3.Value = ""
.TextBox4.Value = CDate(Format(Date, "dd.mm.yyyy"))
.TextBox5.Value = ""
.Top = 6
.Left = 6
End With

With .Label11
.Left = 6
.Top = 126
.Visible = False
End With

.Frame1.TextBox1.SetFocus

' если пользователь хочет создать проект
If tip = "Создать проект" Then
.Height = 448
.Label18.Visible = True
.Label19.Visible = True
.Label20.Visible = True
.Label21.Visible = True
.Label22.Visible = True
.Label23.Visible = True
.CommandButton8.Visible = True
.CommandButton9.Visible = True

.Frame2.Visible = True

.Label11.Top = 390
.CommandButton5.Top = 390
.CommandButton6.Top = 390
.Frame2.TextBox9.Value = CDate(Format(Date, "dd.mm.yyyy"))
End If
End With

' выравниваем форму по центру окна excel
UserForm3.Top = (Application.Height - UserForm3.Height) / 2
UserForm3.Left = (Application.Width - UserForm3.Width) / 2
End Function

Процедура работоспособности кнопки «Назад»:

' кнопка "назад"
Private Sub CommandButton6_Click()
' изменяем форму, на форму "по умолчанию"
Module1.uf3_def
End Sub

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

' нажатие на календарь
Private Sub Image2_Click()
With UserForm4
.Caption = "Дата создания"
.Show
End With
End Sub

' двойное нажатие на поле "выполнить до"
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With UserForm4
.Caption = "Дата ""Выполнить до"""
.Show
End With
End Sub

' двойное нажатие на поле "дата создания"
Private Sub TextBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
With UserForm4
.Caption = "Дата создания"
.Show
End With
End Sub

Форма всплывающего календаря:

Форма календаря
Форма выбора даты на календаре

Сам же функционал и его реализация один в один как в статье «выбор даты «Выполнить до» на календаре»

При создании проекта, необходимо предоставить пользователю возможность создания новых подзадач, для этого сделаем процедуру, выполняющуюся при нажатии на кнопку «+»:

' добавить подзадачу, кнопка "+"
Private Sub CommandButton8_Click()
UserForm3.Label11.Visible = False

num2 = num - 1

' добавляем номер подпункта
Set mylabel = UserForm3.Frame2.Controls.Add("Forms.Label.1", "Label" & num3 + 11)
With mylabel
.Caption = num3 & "."
.Top = UserForm3.Frame2.Controls("TextBox" & num2).Top + UserForm3.Frame2.Controls("TextBox" & num2).Height + 8
.Left = 4
End With
num3 = num3 + 1

' добавляем 5 TextBox'сов
For i = 1 To 5
Set MyTextBox = UserForm3.Frame2.Controls.Add("Forms.TextBox.1", "TextBox" & num)
With MyTextBox
.Height = 13.2
.Top = UserForm3.Frame2.Controls("TextBox" & num2).Top + UserForm3.Frame2.Controls("TextBox" & num2).Height + 6
mytop = .Top
Select Case i
Case 1
.Left = 18
.Width = 150
.SetFocus
.Tag = num3 - 1
Case 2
.Left = 174
.Width = 55
Case 3
.Left = 234
.Width = 90
Case 4
.Left = 330
.Width = 55
.Value = CDate(Format(Date, "dd.mm.yyyy"))
Case 5
.Left = 390
.Width = 120
End Select
.BorderStyle = 1
End With
num = num + 1
Next i

' прокручиваем скролл вниз
With UserForm3.Frame2
.ScrollHeight = mytop + 19.2
.ScrollTop = mytop + 19.2
If (mytop + 19.2) > .Height Then .ScrollBars = fmScrollBarsVertical
End With
End Sub

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

' удалить подзадачу, кнопка "-"
Private Sub CommandButton9_Click()
If num3 > 2 Then
num2 = num - 6

k = num3 + 10
UserForm3.Frame2.Controls.Remove "Label" & k
For i = num3 * 5 - 4 To num3 * 5
UserForm3.Frame2.Controls.Remove "TextBox" & i
Next i
num = num - 5
num3 = num3 - 1

' прокручиваем скролл вниз
mytop = UserForm3.Frame2.Controls("TextBox" & num2).Top + UserForm3.Frame2.Controls("TextBox" & num2).Height + 6
With UserForm3.Frame2
.ScrollHeight = mytop - 6
.ScrollTop = mytop - 6
If (mytop - 6) < .Height Then .ScrollBars = fmScrollBarsNone
End With
Else
With UserForm3.Label11
.Caption = "Проект должен содержать хотя бы один подпункт"
.Visible = True
End With
End If
End Sub

Реализуем работоспособность кнопки «Ок», т.е. сохранение введенных в форму данных на соответствующих листах Планеро:

' кнопка "ок"
Private Sub CommandButton5_Click()
UserForm3.Label11.Visible = False

' если не введено наименование задачи
If Len(UserForm3.TextBox1.Value) <= 0 Then
With UserForm3.Label11
.Caption = "Введите наименование задачи"
.Visible = True
End With
UserForm3.Frame1.TextBox1.SetFocus
Else
Set f = UserForm3.Frame1
If UserForm3.Frame1.Caption = "Создать проект" Then
' проверяем заполненность наименований подзадач
i = num - 5
Do While i >= 6
If Len(UserForm3.Frame2.Controls("TextBox" & i).Value) <= 0 Then
With UserForm3.Label11
.Caption = "Введите или удалите подзадачу №" & UserForm3.Frame2.Controls("TextBox" & i).Tag
.Visible = True
End With
UserForm3.Frame2.Controls("TextBox" & i).SetFocus
Exit Do
End If
i = i - 5
Loop
If UserForm3.Label11.Visible = False Then
b = Module1.newzap(f.TextBox1.Value, f.TextBox2.Value, f.TextBox3.Value, f.TextBox4.Value, f.TextBox5.Value, "Проекты")
Set pr = Workbooks("planero.xlsm").Worksheets("Проекты")
End If
Else
If f.Caption = "Добавить задачу во входящие" Then
b = Module1.newzap(f.TextBox1.Value, f.TextBox2.Value, f.TextBox3.Value, f.TextBox4.Value, f.TextBox5.Value, "Входящие")
Set pr = Workbooks("planero.xlsm").Worksheets("Входящие")
End If
If f.Caption = "Добавить задачу в отложенные" Then
b = Module1.newzap(f.TextBox1.Value, f.TextBox2.Value, f.TextBox3.Value, f.TextBox4.Value, f.TextBox5.Value, "Отложенные")
Set pr = Workbooks("planero.xlsm").Worksheets("Отложенные")
End If
If f.Caption = "Добавить задачу в периодическое" Then
b = Module1.newzap(f.TextBox1.Value, f.TextBox2.Value, f.TextBox3.Value, f.TextBox4.Value, f.TextBox5.Value, "Периодическое")
Set pr = Workbooks("planero.xlsm").Worksheets("Периодическое")
End If

b = Module1.new_number(pr)
End If
End If
End Sub

В процедуре Private Sub CommandButton5_Click() проверяется, ввел ли пользователь наименование задачи и подзадачи (в случае выбора проекта). В случае отсутствия данные – курсор переводится в поле, которое необходимо заполнить, а также выводится информация пользователю об ошибке.

Ошибка: не введено наименование задачи

Также в процедуре используется функция newzap, предназначенная для сохранения введенных данных:

' добавление новой записи для страницы
Function newzap(zadacha, data_do, docum, data_soz, kom, tip)
If tip = "Проекты" Then
i = num - 5
k = num3 - 1
Else
i = 1
End If
Do While i >= 1
Set vh = Workbooks("planero.xlsm").Worksheets(tip)
vh.Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With vh.Rows("3:3").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With vh.Range("B3:D3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
If tip <> "Проекты" Or i = 1 Then .Merge
End With
vh.Range("A3:H3").Font.Bold = False
If tip <> "Проекты" Or i = 1 Then
vh.Range("A3:D3").Font.Bold = True
With vh.Range("E3")
.HorizontalAlignment = xlRight
.NumberFormat = "m/d/yyyy"
End With
With vh.Range("G3")
.HorizontalAlignment = xlRight
.NumberFormat = "m/d/yyyy"
End With
With vh.Range("H3")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
vh.Range("F3").HorizontalAlignment = xlLeft
vh.Range("B3:D3").HorizontalAlignment = xlLeft
With vh.Range("A3")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
If tip = "Проекты" And i > 1 Then vh.Range("C3").HorizontalAlignment = xlRight
With vh.Rows("3:3").Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
If tip <> "Проекты" Or i = 1 Then
vh.Range("A3") = 1
vh.Range("B3") = zadacha

' высота строки задачи в зависимости от количество символов (т.к. ячейка объединенная и высота автоматически не подбирается excel'ем
vis = 14.4
len_text = Len(zadacha) / 74
If len_text > 1 Then vis = 14.4 * 2
If len_text > 2 Then vis = 14.4 * 3
If len_text > 3 Then vis = 14.4 * 4
If len_text > 4 Then vis = 14.4 * 5
If len_text > 5 Then vis = 14.4 * 6
vh.Range("B3").RowHeight = vis

If IsDate(data_do) Then vh.Range("E3") = CDate(data_do) Else vh.Range("E3") = ""
vh.Range("F3") = docum
If IsDate(data_soz) Then vh.Range("G3") = CDate(data_soz) Else vh.Range("G3") = ""
If tip = "Проекты" Then
If Len(kom) > 0 Then
vh.Range("H3") = "[Выполнено 0 из " & (num3 - 1) & " - 0%]" & Chr(10) & kom
Else
vh.Range("H3") = "[Выполнено 0 из " & (num3 - 1) & " - 0%]"
End If
Else
vh.Range("H3") = kom
End If
Else
zadacha2 = UserForm3.Frame2.Controls("TextBox" & i).Value
data_do2 = UserForm3.Frame2.Controls("TextBox" & i + 1).Value
docum2 = UserForm3.Frame2.Controls("TextBox" & i + 2).Value
data_soz2 = UserForm3.Frame2.Controls("TextBox" & i + 3).Value
kom2 = UserForm3.Frame2.Controls("TextBox" & i + 4).Value

vh.Range("C3") = k
vh.Range("D3") = zadacha2
If IsDate(data_do2) Then vh.Range("E3") = CDate(data_do2) Else vh.Range("E3") = ""
vh.Range("F3") = docum2
If IsDate(data_soz2) Then vh.Range("G3") = CDate(data_soz2) Else vh.Range("G3") = ""
vh.Range("H3") = kom2

' добавляем границы таблицы в "B3:D3"
With vh.Range("B3:D3")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With vh.Range("B3:D3").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With vh.Range("B3:D3").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With vh.Range("B3:D3").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With vh.Range("B3:D3").Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With vh.Range("B3:D3").Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If tip <> "Входящие" Then
With vh.Range("K3")
h = 1
If tip = "Проекты" Then h = 2
Do While h >= 1
If tip = "Проекты" Then
.FormulaLocal = "=ЕСЛИ(ИЛИ(B3>0;D3>0);""выполнено"";" & """"")"
If h = 2 Then .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""выполнено"""
If h = 1 Then .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""невыполнено"""
Else
.FormulaLocal = "=ЕСЛИ(B3>0;""Выполнено"";" & """"")"
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Выполнено"""
End If

.FormatConditions(vh.Range("K3").FormatConditions.Count).SetFirstPriority
With .FormatConditions(1).Borders(xlLeft)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .FormatConditions(1).Borders(xlRight)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .FormatConditions(1).Borders(xlTop)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .FormatConditions(1).Borders(xlBottom)
.LineStyle = xlContinuous
.TintAndShade = 0
.Weight = xlThin
End With
With .FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599963377788629
End With
.FormatConditions(1).StopIfTrue = False
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter

h = h - 1
Loop
End With
End If

i = i - 5
k = k - 1
Loop

Unload UserForm3
End Function

И функция new_number, обновляющая номера ранее введенных задач при добавлении новых:

' функция обновления номеров задач
Function new_number(pr)
i = 0
num = 1
' проходим вниз до тех пор пока есть тест в столбцах В и С
Do While pr.Range("B3").Offset(i, 0) > 0 Or pr.Range("D3").Offset(i, 0) > 0
If pr.Range("B3").Offset(i, 0) > 0 Then
pr.Range("A3").Offset(i, 0) = num
num = num + 1
End If
i = i + 1
Loop
End Function

Скачать актуальную версию Планеро с вышеописанными возможностями.

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

© планеро.ru