Сторінка
10

Автоматизацiя контролю вiдвiдування студентами занять

.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, _