Сводная ведомость успеваемости excel

1
2
3
4
5
6
7
8
9
10
11
12
13
14

' Листинг 5.1. Процедура, выполняемая при открытии книги
Private Sub Workbook_Open()
N = 0
While Worksheets("Справочник").Cells(N + 1, 1).Value <> ""
	N = N + 1
Wend
Worksheets("Оценки учащегося").Plan.Clear
Worksheets("Оценки учащегося").Student.Clear
For i = 1 To N
	a = Worksheets("Справочник").Cells(i, 1).Value
    Worksheets("Оценки учащегося").Plan.AddItem a
Next
Worksheets("Оценки учащегося").Range("A8").Value = ""
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

' Листинг 5.2. Процедура обработки щелчка на кнопке Заполнить список учащихся
Private Sub SpStud_Click()
N = 0
While Worksheets("Учащиеся").Cells(N + 1, 1).Value <> ""
	N = N + 1
Wend
Student.Clear
For i = 1 To N
	If CStr(Worksheets("Учащиеся").Cells(i + 1, 2).Value) = _
    CStr(Plan.Text) Then
    a = Worksheets("Учащиеся").Cells(i + 1, 1).Value
    Student.AddItem a
    End If
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

' Листинг 5.3. Процедура обработки щелчка на списке учащихся
Private Sub Student_Click()
N = 0
While Worksheets("Учащиеся").Cells(N + 2, 1).Value <> ""
	N = N + 1
Wend
For i = 1 To N
	If CStr(Worksheets("Учащиеся").Cells(i + 1, 2).Value) = _
    CStr(Plan.Text) And
    CStr(Worksheets("Учащиеся").Cells(i + 1, _
    1).Value) = CStr(Student.Text) Then
    Cells(8, 1).Value = i + 1
    Exit For
    End If
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

' Листинг 5.4. Процедура обработки щелчка на кнопке Osenki
Private Sub Osenki_Click()
' Предварительная очистка области на экране
Range("A11:E200").Value = ""
If Student.Text = "" Then
	MsgBox ("не выбран учащийся")
    Exit Sub
End If
' Подсчет дисциплин на листе Планы
N = 0
While Worksheets("Планы").Cells(N + 2, 1).Value <> ""
	N = N + 1
Wend
Num = 11
' Номер строки на листе, с которой начинается вывод информации
For i = 1 To N 
' Цикл по числу дисциплин на листе Планы
	a = Worksheets("Планы").Cells(i + 1, 7).Value
    If CStr(a) = CStrPlan.Text) Then
' Если дисциплина из выбранного учебного плана
	b = CInt(Worksheets("Планы").Cells(i + 1, 1).Value)
' Запись номера дисциплины
	Cells(Num, 1).Value = b
' Запись названия дисциплины и ее параметров
	Cells(Num, 2).Value = Worksheets("Планы").Cells(i + 1, 2).Value
	Cells(Num, 3).Value = Worksheets("Планы").Cells(i + 1, 3).Value
	Cells(Num, 4).Value = Worksheets("Планы").Cells(i + 1, 4).Value
' Извлечение оценки по дисциплине с листа Учащиеся
	osenka = Worksheets("Учащиеся").Cells(Cells(8, 1).Value, b + 2).Value
' Запись оценки
	Cells(Num, 5).Value = osenka
' Увеличение счетчика выводимых строк на листе
	Num = Num + 1
    End If
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

' Листинг 5.5. Процедура для записи информации в базу данных
Private Sub OK_Click()
' Проверка пароля и выбора учащегося
If Pass.Text = "csm" And Cells(8, 1) <> "" Then
' Извлекаем номер строки, в которую будем производить запись информации
	NumStud = Cells(8, 1).Value
' Подсчет числа дисциплин выбранного учебного плана
N = 0
While Cells(N + 11, 1).Value <> ""
	N = N + 1
Wend
For i = 1 To N
' Вычисляем номер столбца на листе Учащиеся, где находится оценка
	a = 2 + Cells(i + 10, 1).Value
' Запись оценки
	Worksheets("Учащиеся").Cells(NumStud, a).Value = Cells(i + 10, 5).Value
    Next
    MsgBox ("Информация записана")
Else
    MsgBox ("Информация не записана")
End If
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

' Листинг 5.6. Измененная процедура Workbook_Open (вариант 2)
Private Sub Workbook_Open()
N = 0
While Worksheets("Справочник").Cells(N + 1, 1).Value <> ""
	N = N + 1
Wend
Worksheets("Оценки учащегося").Plan.Clear
Worksheets("Оценки учащегося").Student.Clear
Worksheets("Ввод учащихся").Plan.Clear
For i = 1 To N
	a = Worksheets("Справочник").Cells(i, 1).Value
    Worksheets("Оценки учащегося").Plan.AddItem a
    Worksheets("Ввод учащихся").Plan.AddItem a
Next
Worksheets("Оценки учащегося").Range("A8").Value = ""
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

' Листинг 5.7. Процедура обработки щелчка на кнопке Запись
Private Sub OK_Click()
' Проверка указания учебного плана
If Plan.Text = "" Then
	MsgBox ("Не указан поток")
    Exit Sub
End If
' Подсчет уже имеющихся записей на листе Учащиеся
N = 0
While Worksheets("Учащиеся").Cells(N + 2, 1).Value <> ""
	N = N + 1
Wend
' Внесение фамилии
Worksheets("Учащиеся").Cells(N + 2, 1).Value = Cells(3, 3).Value
' Внесение названия учебного плана
Worksheets("Учащиеся").Cells(N + 2, 2).Value = Plan.Text
MsgBox ("Данные введены")
' Очистка ячейки с фамилией
Range("C3").Value = ""
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

' Листинг 5.8. Измененная процедура Workbook_Open (вариант 3)
Private Sub Workbook_Open()
N = 0
While Worksheets("Справочник").Cells(N + 1, 1).Value <> ""
	N = N + 1
Wend
Worksheets("Оценки учащегося").Plan.Clear
Worksheets("Оценки учащегося").Student.Clear
Worksheets("Ввод учащихся").Plan.Clear
Worksheets("Ведомость").Plan.Clear
For i = 1 To N
    a = Worksheets("Справочник").Cells(i, 1).Value
    Worksheets("Оценки учащегося").Plan.AddItem a
    Worksheets("Ввод учащихся").Plan.AddItem a
    Worksheets("Ведомость").Plan. AddItem a
Next
Worksheets("Оценки учащегося").Range("A8").Value = ""
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

' Листинг 5.9. Процедура обработки щелчка на кнопке Заполнить дисциплины
Private Sub ComD_Click()
Disp.Clear
' Подсчет числа дисциплин на листе Планы
N = 0
While Worksheets("Планы").Cells(N + 2, 1).Value
    N = N + 1
Wend
For i = 1 To N
b = Worksheets("Планы").Cells(i + 1, 7).Value
    If CStr(b) = CStr(Plan.Text)
Then
' Если название учебного плана совпадает с указанным
    Disp.AddItem Worksheets("Планы").Cells(i + 1, 2).Value
    End If
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

' Листинг 5.10. Процедура обработки щелчка на поле со списком Disp
Private Sub Disp_Click()
N = 0
While Worksheets("План").Cells(N + 2, 1).Value <> ""
N = N + 1
Wend
For i = 1 To N
If Plan.Text = Worksheets("План").Cells(i + 1, 7).Value And _
    Disp.Text = Worksheets("План").Cells(i + 1, 2).Value Then
' Извлечение номера дисциплины
    kod = Worksheets("План").Cells(i + 1, 1).Value
    Exit For
    End If
Next
' Отражение параметров дисциплины в шестой строке листа
Range("A6").Value = Worksheets("План").Cells(i + 1, 2).Value
Range("B6").Value = Worksheets("План").Cells(i + 1, 4).Value
Range("C6").Value = Worksheets("План").Cells(i + 1, 3).Value
Range("D6").Value = kod
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40

' Листинг 5.11. Процедура заполнения ведомости
Private Sub ComV_Click()
' В ячейке D6 предварительно мы записали код (номер) дисциплины
NomerDisp = Cells(6, 4).Value
' Выход, если не указана дисциплина
If NomerDisp = "" Then
    MsgBox ("Не указана дисциплина")
    Exit Sub
End If
' Очистка области вывода
Range("A10:B200") = ""
' Подсчет числа учащихся
N = 0
While Worksheets("Учащиеся").Cells(N + 2, 1).Value <> ""
    N = N + 1
Wend
' В следующей переменной мы организуем счетчик фамилий на дан-
ном листе
NumStud = 0
For i = 1 To N
If СStr(Worksheets("Учащиеся").Cells(i + 1, 2).Value) = _
    CStr(Plan.Text) Then
' Внесение фамилии
    Cells(NumStud + 10, 1).Value = _
    Worksheets("Учащиеся").Cells(i + 1, 1).Value
' В 100-й столбец записываем номер строки, которая отводится для учащегося
Cells(NumStud + 10, 100).Value = i + 1
NumStud = NumStud + 1
End If
Next
' Цикл по числу отобранных фамилий
For j = 1 To NumStud
' Извлечение номера строки очередного учащегося
IndStud = Cells(j + 9, 100).Value
' Извлечение оценки учащегося
Osenka = Worksheets("Учащиеся").Cells(IndStud,2 + CInt (NomerDisp)).Value
' Отражение оценки
Cells(j + 9, 2).Value = Osenka
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

' Листинг 5.12. Процедура записи информации на лист Учащиеся
Private Sub OK_Click()
If Pass.Text = "csm" Then
' Подсчет числа фамилий, внесенных на данный лист
N = 0
While Cells(N + 10, 1) <> ""
    N = N + 1
Wend
' В данную ячейку мы предварительно записали номер дисциплины
NomerDisp = Cells(6, 4).Value
For j = 1 To N
' Получение номера строки с информацией по студенту
    IndStud = Cells(j + 9, 100).Value
' Получение информацию об оценке с текущего листа
    Osenka = Cells(j + 9, 2).Value
' Внесение оценки на лист Учащиеся
    Worksheets("Учащиеся").Cells(IndStud, 2 + NomerDisp).Value = Osenka
Next
MsgBox ("Информация внесена")
Else
MsgBox ("Информация не внесена")
End If
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

' Листинг 5.13. Процедура, выполняемая по щелчку на кнопке Печать
Private Sub Prn_Click()
' Заполнение шапки документа
Worksheets("Печатная форма").Cells(3, 6) = Plan.Text
Worksheets("Печатная форма").Cells(7, 8) = Cells(4, 6)
Worksheets("Печатная форма").Cells(3, 5) = Cells(6, 2)
Worksheets("Печатная форма").Cells(7, 8) = Cells(6, 3)
Worksheets("Печатная форма").Cells(4, 3) = Disp.Text
' Очистка табличной области
Worksheets("Печатная форма").Range("A12:M200") = ""
' Удаление границ
With Worksheets("Печатная форма").Range("A12:M200")
.Borders.LineStyle = xlNone
End With
' Подсчет числа студентов в группе
N = 0
While Cells(10 + N, 1).Cells <> ""
N = N + 1
Wend
' Заполнение печатной формы
For i = 1 To N
' Внесение порядкового номера
Worksheets("Печатная форма").Cells(i + 11, 1) = i
' Внесение фамилии
Worksheets("Печатная форма").Cells(i + 11, 2) = Cells(i + 9, 1)
' Оформление границ ячеек
    For j = 1 To 8
    With Worksheets("Печатная форма").Cells(i + 11, j)
    .Borders.LineStyle = xlContinuous
    End With
    Next
Next
Worksheets("Печатная форма").Cells(i + 11, 1) = _
" Число студентов на экзамене (зачете) _______________"
Worksheets("Печатная форма").Cells(i + 12, 1) = _
" Из них получивших отлично _______________"
Worksheets("Печатная форма").Cells(i + 13, 2) = _
" получивших хорошо _______________"
Worksheets("Печатная форма").Cells(i + 14, 2) = _
"получивших удовлетворительно _______________"
Worksheets("Печатная форма").Cells(i + 15, 2) = _
"получивших неудовлетворительно _______________"
Worksheets("Печатная форма").Cells(i + 16, 2) = _
" Число студентов, не явившихся на экзамен (зачет) _________"
Worksheets("Печатная форма").Cells(i + 17, 1) = _
"Число студентов, не допущенных к экзамену (зачету) _________"
Worksheets("Печатная форма").Cells(i + 19, 4) = "Декан факультета _______________ Ю.В.Воронков "
Worksheets("Печатная форма").Activate
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

' Листинг 5.14. Процедура, выполняемая при активизации листа
Private Sub Worksheet_Activate()
Sem.Clear
' При указании числа семестров мы ограничились пятью
For i = 1 To 5
    Sem.AddItem i
Next
Plan.Clear
N = 0
While Worksheets("Справочник").Cells(N + 1, 1).Value <> ""
    N = N + 1
Wend
For i = 1 To N
    a = Worksheets("Справочник").Cells(i, 1).Value
    Plan.AddItem a
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

' Листинг 5.15. Процедура обработки щелчка на кнопке Заполнить таблицу
Private Sub OK_Click()
If IsNumeric(Sem.Text) = False Then
    MsgBox ("Не выбран семестр")
    Exit Sub
End If
    Semestr = CInt(Sem.Text)
' Очистка области заголовков столбцов
Range("B7:Z9") = ""
' Очистка основной области
Range("A10:Z200") = ""
' Подсчет общего числа дисциплин
N = 0
While Worksheets("Планы").Cells(N + 2, 1).Value <> ""
    N = N + 1
Wend
'Заполнение дисциплин, попавших в указанный семестр
Nom = 2
' Номер столбца, с которого начинается заполнение
ColsDisp = 0
' Счетчик количества дисциплин
For i = 1 To N
SemNum = CInt(Worksheets("Планы").Cells(i + 1, 3).Value)
If CStr(Worksheets("Планы").Cells(i + 1, 7).Value) = CStr (Plan.Text) And SemNum = Semestr Then
' Внесение названия очередной дисциплины в сводную таблицу
Cells(7, Nom).Value = Worksheets("Планы").Cells(i + 1, 2).Value
' Внесение номера семестра
Cells(8, Nom).Value = Sem
' Внесение формы отчетности
Cells(9, Nom).Value = Worksheets("Планы").Cells(i + 1, 4).Value
' Фиксирование в 200-й строке номера дисциплины
Cells(200, Nom).Value = Worksheets("Планы").Cells(i + 1, 1).Value
Nom = Nom + 1
ColsDisp = ColsDisp + 1
End If
Next
' Подсчет числа студентов
Nstud = 0
While Worksheets("Учащиеся").Cells(Nstud + 2, 1).Value <> ""
Nstud = Nstud + 1
Wend
Num = 0
For i = 1 To Nstud
    If Worksheets("Учащиеся").Cells(i + 1, 2).Value = Plan Then
' Извлечение очередной фамилии студента, обучающегося по указанному плану
    a = Worksheets("Учащиеся").Cells(i + 1, 1).Value
' Запись фамилии учащегося в первый столбец
    Cells(Num + 10, 1).Value = a
' Фиксирование в 100-м столбце номера строки учащегося
    Cells(Num + 10, 100).Value = i + 1
    Num = Num + 1
    End If
Next
' Внесение оценок
For j = 1 To Nstud
If CStr(Worksheets("Учащиеся").Cells(j + 1, 2).Value) = CStr (Plan) Then
' Извлечение номера строки студента
    IndStud = Cells(j + 9, 100).Value
    For ld = 1 To ColsDisp
    NumDisp = Cells(200, ld + 1).Value
' Извлечение и фиксирование оценок
Osenka = Worksheets("Учащиеся").Cells(IndStud, 2 + NumDisp).Value
Cells(j + 9, ld + 1).Value = Osenka
Next
End If
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14

' Листинг 5.16. Процедура Worksheet_Activate
Private Sub Worksheet_Activate()
Plan.Clear
' Подсчет различных учебных планов
N = 0
While Worksheets("Справочник").Cells(N + 1, 1).Value <> ""
    N = N + 1
Wend
' Заполнение поля со списком
For i = 1 To N
    a = Worksheets("Справочник").Cells(i, 1).Value
    Plan.AddItem a
Next
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

' Листинг 5.17. Процедура обработки щелчка на кнопке Заполнить
Private Sub OK_Click()
If Plan.ListIndex = -1 Then
    MsgBox ("Не указан поток")
    Exit Sub
End If
Range("a11:f200").Value = "" ' Очистка области вывода
' Устранение заливки в области вывода
Range("a11:f200").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = 0
End With
N = 0
While Worksheets("Планы").Cells(N + 2, 1).Value <> ""
    N = N + 1
Wend
Num = 11 ' Номер строки, с которой начинается вывод информации
For i = 1 To N
    a = Worksheets("Планы").Cells(i + 1, 7).Value
' Если дисциплина соответствует выбранному учебному плану
    If CStr(a) = CStr(Plan.Text) Then
    b = Worksheets("Планы").Cells(i + 1, 1).Value ' Код дисциплины
' Перенос на лист параметров дисциплины
    Cells(num, 1).Value = b
    Cells(num, 2).Value = Worksheets("Планы").Cells(i + 1, 2).Value
    Cells(num, 3).Value = Worksheets("Планы").Cells(i + 1, 3).Value
    Cells(num, 4).Value = Worksheets("Планы").Cells(i + 1, 4).Value
    Cells(num, 5).Value = Worksheets("Планы").Cells(i + 1, 5).Value
    Cells(num, 6).Value = Worksheets("Планы").Cells(i + 1, 6).Value
    num = num + 1
    End If
Next
' Сортировка по семестрам
Range("A11:F110").Select
Selection.Sort Key1:=Range("C11"), Order1:=xlAscending, _
Key2:=Range("B11"), Order2:=xlAscending, Key3:=Range("D11"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3: = xlSortNormal
N = 0
While Cells(N + 11, 1).Value <> ""
    N = N + 1
Wend
' Расцветка дисциплин различных семестров
For i = 1 To N
    semestr = Cells(i + 10, 3).Value
    If semestr Mod 2 = 0 Then
    Range(Cells(i + 10,1), Cells(i + 10,6)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 35
	End With
	End If
    If semestr Mod 2 = 1 Then
    Range(Cells(i + 10,1), Cells(i + 10,6)).Select
    With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = 40
    End With
    End If
Next
Range("A1").Select
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

' Листинг 5.18. Процедура обработки щелчка на кнопке Сортировка по семестрам
Private Sub SortSem_Click()
Range("A11:F110").Select
Selection.Sort Key1:=Range("C11"), Order1:=xlAscending, _
Key2:=Range("B11"), Order2:=xlAscending, Key3:=Range("D11"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3: = xlSortNormal
N = 0
While Cells(N + 11, 1).Value <> ""
    N = N + 1
Wend
' Расцветка дисциплин различных семестров
For i = 1 To N
    semestr = Cells(i + 10, 3).Value
    If semestr Mod 2 = 0 Then
    Range(Cells(i + 10,1), Cells(i + 10,6)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 35
    End With
    End If
    If semestr Mod 2 = 1 Then
    Range(Cells(i + 10,1), Cells(i + 10,6)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 40
    End With
    End If
Next
Range("A1").Select
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

' Листинг 5.19. Процедура обработки щелчка на кнопке Внести изменения в план
Private Sub IzmPlan_Click()
' Подсчет дисциплин в листе План
N = 0
While Worksheets("Планы").Cells(N + 2, 1).Value <> ""
    N = N + 1
Wend
' Подсчет дисциплин на данном листе
L = 0
While Cells(L + 11, 1).Value <> ""
    L = L + 1
Wend
PlanCorr = Plan.Text
For i = 1 To L
    kod = CInt(Cells(10 + i, 1).Value)
' Код дисциплины на данном листе
    For j = 1 To N
' Код дисциплины учебного плана
    kodplan = CInt(Worksheets("Планы").Cells(j + 1, 1).Value)
    If kodplan = kod And PlanCorr = _
    CStr(Worksheets("Планы").Cells(j + 1, 7).Value) Then
    Worksheets("Планы").Cells(j + 1, 2).Value = Cells(10 + i, 2).Value
    Worksheets("Планы").Cells(j + 1, 3).Value = Cells(10 + i, 3).Value
    Worksheets("Планы").Cells(j + 1, 4).Value = Cells(10 + i, 4).Value
    Worksheets("Планы").Cells(j + 1, 5).Value = Cells(10 + i, 5).Value
    Worksheets("Планы").Cells(j + 1, 6).Value = Cells(10 + i, 6).Value
    End If
    Next
Next
End Sub