False
Лист1.CommandButton2.Enabled = True
Лист1.CommandButton3.Enabled = True
Лист1.Range("A1").Value = "Yes"
End If
End Sub
Макрос клавіші “Очистити” на листі “Ввід”
Реакція програми на натиснення клавіші “Очистити”:
Вивід попереджувального вікна і отримання відповіді від користувача
В випадку позитивної відповіді:
заборона виводу прізвищ
Відключення клавіш “Очистити” і “Зберегти”
Включення елементів вибору групи і місяця та клавіші “Вивести”
Private Sub CommandButton2_Click()
but = MsgBox("Ви дійсно хочете очистити таблицю відвідування ?", vbQuestion _
+ vbOKCancel)
If but = 1 Then
Range("E7:AI100").Cells.Formula = ""
Range("E5").Value = ""
Лист1.ComboBox1.Enabled = True
Лист1.ComboBox2.Enabled = True
Лист1.CommandButton2.Enabled = False
Лист1.CommandButton1.Enabled = True
Лист1.CommandButton3.Enabled = False
Range("A1").Value = "No"
End If
End Sub
Макрос клавіші “Зберегти” на листі “Ввід”
Реакція програми на натиснення клавіші “Зберегти”:
Перевірка листа на предмет наявності помилок і в випадку їх присутності вивід відповідного повідомлення.
Збереження даних на відповідному листі:
Заборона виводу прізвищ
Відключення клавіш “Очистити” і “Зберегти”
Включення елементів вибору групи і місяця та клавіші “Вивести”
Private Sub CommandButton3_Click()
If Лист1.Range("A6") <> 0 Then
but = MsgBox("В даних знадені помилки. Виправте їх перед збережанням", vbCritical)
Else
but = MsgBox("Ви дійсно хочете зберегти дані відвідування ?", vbQuestion _
+ vbOKCancel)
If but = 1 Then
Лист1.Range("E5").Value = ""
Лист1.Range("E7:AI100").Copy
Sheets(Лист1.Range("A5").Value).Range("C3").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Лист1.Range("E7:AI100").Cells.Formula = ""
Лист1.ComboBox1.Enabled = True
Лист1.ComboBox2.Enabled = True
Лист1.CommandButton2.Enabled = False
Лист1.CommandButton1.Enabled = True
Лист1.CommandButton3.Enabled = False
Лист1.Range("A1").Value = "No"
End If
End If
End Sub
Макрос клавіші “Створити” на листі “Звіт”
Реакція програми на натиснення клавіші “Створити”:
Очистка листа від попереднього звіту
Для кожного вибраного в ListBox листа:
Вивід «шапки»
Перегляд даних і перевірка даних по кількості пропусків
Копіювання відібраних даних на лист «Звіт»
Створення узагальненого звіту
Створення діаграми
Private Sub CommandButton1_Click()
RW = 17
GR = 0
Range("A17:AI5000").Clear
For I = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(I) Then
'SH - Назва листа даних з поточною групою і місяцем
SH = Mid(ListBox1.List(I), 38, 6)
'Друкуємо шапку для групи і місяця
With Range("A" + Mid(Str(RW), 2) + ":AI" + Mid(Str(RW), 2))
.Merge
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Value = Mid(ListBox1.List(I), 1, 29)
.Interior.ColorIndex = 4
End With
RW = RW + 1
PN = 1
'Шапка (З днями)
Range("A16:AI16").Copy
Range("A" + Mid(Str(RW), 2)).PasteSpecial
With Range("A" + Mid(Str(RW), 2) + ":AI" + Mid(Str(RW), 2))
.Interior.ColorIndex = 4
.Font.Bold = True
.Font.Color = 0
End With
RW = RW + 1
'Переглядаємо діапазон "AH3:AH100"
For Each Cel In Sheets(SH).Range("AH3:AH100")
'Але крім порожніх комірок і крім "ВСЬОГО"
If (Cel.Value <> "") And (Sheets(SH).Range("B" + Mid(Str(Cel.Row), 2)).Value <> "ВСЬОГО") Then
'Для тих комірок, що задовільняють всі вищеперечислені умови перевіряємо
'чи підходять вони по критеріях відбору за максимально дозволеними кількостями
If (Cel.Value > Sheets("Звіт").Range("N3").Value) Or _
(Sheets(SH).Range("AI" + Mid(Str(Cel.Row), 2)).Value > Sheets("Звіт").Range("R3").Value) Then
'Номер
Range("A" + Mid(Str(RW), 2)).Value = PN
PN = PN + 1
'Копіюємо прізвище і дані
Sheets(SH).Range("B" + Mid(Str(Cel.Row), 2) + ":AI" + Mid(Str(Cel.Row), 2)).Copy
Range("B" + Mid(Str(RW), 2) + ":AI" + Mid(Str(RW), 2)).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
RW = RW + 1
End If
End If
Next
'ВСЬОГО
Range("B" + Mid(Str(RW), 2)).Value = "ВСЬОГО"
Range("A" + Mid(Str(RW), 2) + ":" + "AI" + Mid(Str(RW), 2)).Font.Bold = True
If PN > 1 Then Range("AH" + Mid(Str(RW), 2)).FormulaR1C1 = "=SUM(R[-" + Mid(Str(PN - 1), 2) + "]C:R[-1]C)" _
Else Range("AH" + Mid(Str(RW), 2)).Value = 0
If PN > 1 Then Range("AI" + Mid(Str(RW), 2)).FormulaR1C1 = "=SUM(R[-" + Mid(Str(PN - 1), 2) + "]C:R[-1]C)" _
Else Range("AI" + Mid(Str(RW), 2)).Value = 0
With Range("C" + Mid(Str(RW), 2) + ":AG" + Mid(Str(RW), 2))
.Merge
.Value = ListBox1.List(I)
.Font.ColorIndex = 2
End With
RW = RW + 1
GR = GR + 1
End If
Next I
'ЗВЕДЕНИЙ ЗВІТ
'(Заголовок)
PN = 0
With Range("A" + Mid(Str(RW), 2) + ":AI" + Mid(Str(RW), 2))
.Merge
.Interior.ColorIndex = 4
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.Size = 18
.Value = "Зведений звіт відвідування"
End With
'(Дані по групам за місяць)
RW = RW + 1
For Each CL In Range("B17:B" + Mid(Str(RW), 2))
If CL.Value = "ВСЬОГО" Then
PN = PN + 1
With Range("B" + Mid(Str(RW), 2) + ":AG" + Mid(Str(RW), 2))
.Merge
.Value = Mid(Range("C" + Mid(Str(CL.Row), 2)).Value, 1, 29)
End With
Range("AH" + Mid(Str(RW), 2)).Value = Range("AH" + Mid(Str(CL.Row), 2)).Value
Range("AI" + Mid(Str(RW), 2)).Value = Range("AI" + Mid(Str(CL.Row), 2)).Value
RW = RW + 1
End If
Next CL
'(Всього)
With Range("B" + Mid(Str(RW), 2) + ":AG" + Mid(Str(RW), 2))
.Merge
.Value = "ВСЬОГО"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Range("AH" + Mid(Str(RW), 2) + ":AG" + Mid(Str(RW), 2)) _
.FormulaR1C1 = "=SUM(R[-" + Mid(Str(PN), 2) + "]C:R[-1]C)"
Range("AI" + Mid(Str(RW), 2) + ":AG" + Mid(Str(RW), 2)) _
.FormulaR1C1 = "=SUM(R[-" + Mid(Str(PN), 2) + "]C:R[-1]C)"
If GR > 2 Then
Range("AH" + Mid(Str(RW - PN), 2) + ":AI" + Mid(Str(RW - 1), 2)).Activate
Charts.Add
ActiveChart.SetSourceData Source:=Sheets("Звіт").Range("AH" + Mid(Str(RW - PN), 2) + ":AI" + Mid(Str(RW - 1), 2))
ActiveChart.Location Where:=xlLocationAsNewSheet
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).XValues = "=Звіт!R" + Mid(Str(RW - PN), 2) + "C2:R" + Mid(Str(RW - 1), 2) + "C33"
ActiveChart.SeriesCollection(1).Name = "=""Б"""
ActiveChart.SeriesCollection(2).XValues = "=Звіт!R" + Mid(Str(RW - PN), 2) + "C2:R" + Mid(Str(RW - 1), 2) + "C33"
ActiveChart.SeriesCollection(2).Name = "=""П"""
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Діаграма відвідування"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Дні"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Position = xlTop
ActiveChart.SeriesCollection(1).ApplyDataLabels Type:=xlDataLabelsShowValue, _
AutoText:=True, LegendKey:=False
ActiveChart.SeriesCollection(2).ApplyDataLabels Type:=xlDataLabelsShowValue, _
AutoText:=True, LegendKey:=False
End If
End Sub
Текст макроса радіо-клавіші “Сортувати по групах” на листі “Звіт”
Private Sub OptionButton1_Click()
ListBox1.Clear
M = 1
For Each Wh In Worksheets
If Mid(Wh.Name, 3, 1) = "-"
