Контрольный пример

2.4 Контрольный пример

2.5 Инструкция пользователя

Для запуска программы необходимо выполнить следующие действия. Нажать кнопку пуск в панели задач; И наитии программу Visual Basic 6.0.

После этого на экране программы появляется с краткой информацией о ней самой в данном режиме пользователю требуется открыть БД. Это можно сделать 2-мя способами: Через меню Файл- Открыть Базу Данных; щелкнуть в панели инструментов пиктограмму открытия БД.

В том и другом случае программа выведет окно в котором пользователь может выбрать или ввести имя и путь к БД. По нажатию кнопки «ОК» программа открывает БД после этого становится до этого не доступная пункт меню «База данных» и все остальные пиктограммы панели инструментов доступными. Программа готова к работе Строка меню состоит из следующих пунктов:

Файл - служит для работы с файлами за режимом закрепляются падающие меню: Открыть БД;

Закрыть БД - после выполнения этого пункта меню программа возвращается в исходное

положение;

Выход;

Таблица - служит для работы с БД. За режимом закрепляется падающие меню:

Таблица «спец меню»;

Таблица «дополнительная информация»;

Сервис служит для работы с запросами по БД. За режимом закрепляется падающие

меню:

Создание БД - после выполнения этого пункта меню запускается второе приложение генерации БД.

Ввод запроса - после выполнения этого пункта меню выводится окно с запросом для поиска.

Окно - служит для работы с окнами. ЗА режимом закрепляется падающие меню:

Закрыть все - позволяет закрыть все открытые окна. Каскад - позволяет расположить окна наложением ; Мозаика - равномерное деление окон на экране; Выстроить значки упорядочить свернутые окна. Панель инструментов состоит из следующих пентаграмм Открыть БД; Закрыть БД; Запрос; Выход;

В панели состояния высвечиваются текущие время и дата.

 ЗАКЛЮЧЕНИЕ

 

В данном Курсовом проекте был разработан программный пакет, позволяющий автоматизировать процесс работы « разработка информационно-поисковой системы по подбору аудиторий.» Продукт был реализован на языке VBA в среде программирования MS Excel.

Для функционирования его на персональном компьютере не обязательно наличие программы Visual Basic 6.0, т.к. для начала работы программы необходимо лишь запустить файл проекта.

Программа достаточно проста в использовании, поэтому приемлема для любого пользователя.

Приложение 1

 

Процедуры листа отчет 2

Private Sub CommandButton1_Click()

Dim colors(10) As Integer

colors(1) = 4 ' Установка цветов

colors(2) = 22 ' для обозначения факультетов

colors(3) = 19

colors(4) = 24

colors(5) = 26

colors(6) = 40

colors(7) = 43

colors(8) = 44

colors(9) = 6

colors(10) = 28

If L1.ListIndex = -1 Then ' Выход, если не выбрана неделя

MsgBox (" Не выбрана неделя ")

Exit Sub

End If

Range("a5:AZ100").Select ' Очистка области данных

Selection.ClearContents

' Подсчет количества учебный дней в неделе

N_Day = 0

While Worksheets(2).Cells(N_Day + 2, 4).Value <> ""

N_Day = N_Day + 1

Wend

' Подсчет количества занятий в течение дня

N_Times = 0

While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""

N_Times = N_Times + 1

Wend

' Подсчет количества аудиторий

N_Ayd = 0

While Worksheets(2).Cells(N_Ayd + 2, 1).Value <> ""

N_Ayd = N_Ayd + 1

Wend

DaysTimes = N_Day * N_Times

N_Boss = 0 ' Подсчет заявителей

While Worksheets(2).Cells(N_Boss + 2, 6).Value <> ""

N_Boss = N_Boss + 1

Wend

Range("b7:AZ100").Select

With Selection.Interior ' Заливка белым цветом области вывода

.ColorIndex = 0

.Pattern = xlSolid

End With

For i = 1 To N_Boss

Cells(2, 2 + i * 2).Select

With Selection.Interior ' Установка обозначений цветов

.ColorIndex = colors(i) ' заявителей

.Pattern = xlSolid

End With

 ' Установка подписей заявителей для соответствующих цветов

 Cells(1, 2 + i * 2).Value = Worksheets(2).Cells(i + 1, 6).Value

Next

 ' Подсчет количества строк с завками на 1-м листе

N = 0

While Worksheets(1).Cells(N + 4, 1).Value <> ""

N = N + 1

Wend

stroka = 7 ' Данные на листе размещаются начиная с седьмой строки

For i = 1 To N_Ayd ' Установка подписей аудиторий

Cells(stroka, 1).Value = _

Worksheets(2).Cells(i + 1, 1).Value

stroka = stroka + 1

Next

St = 1

For i = 1 To N_Day ' Установка подписей занятий

For j = 1 To N_Times

St = St + 1

Cells(5, St).Value = Worksheets(2).Cells(i + 1, 4).Value

Cells(6, St).Value = Worksheets(2).Cells(j + 1, 5).Value

 Next

Next

For i = 1 To DaysTimes

For j = 1 To N_Ayd

Cells(6 + j, i + 1) = 0 'Инициализация ячеек

Next

 Next

For i = 4 To N + 3 ' Цикл по строкам заявок

 If CStr(Worksheets(1).Cells(i, 7).Value) = "да" Then

' Выполнение условия по обслуживанию заявки

stroka = 0

For ia = 1 To N_Ayd

If CStr(Worksheets(1).Cells(i, 8).Value) = _

CStr(Cells(ia + 6, 1).Value) Then

stroka = ia + 6

Exit For

End If

Next

If stroka > 0 And _

CStr(Worksheets(1).Cells(i, CInt(L1.Text) + 11).Value) = _

"*" Then

' Если есть строка с указанной аудиторией

For m = 1 To DaysTimes

' Нахождение столбца на листе для помещения заявки

If CStr(Worksheets(1).Cells(i, 4).Value) = _

CStr(Cells(5, 1 + m).Value) Then

If CStr(Worksheets(1).Cells(i, 5).Value) = _

CStr(Cells(6, 1 + m).Value) Then

stolbec = 1 + m

Exit For

End If

End If

Next

nomer = 1

For iy = 1 To N_Boss 'Определение заявителя в заявке

If CStr(Worksheets(1).Cells(i, 2).Value) _

= CStr(Worksheets(2).Cells(iy + 1, 6).Value) Then

nomer = iy

Exit For

End If

Next

Cells(stroka, stolbec).Value = _

Cells(stroka, stolbec).Value + _

Worksheets(1).Cells(i, 6).Value

Cells(stroka, stolbec).Select

With Selection.Interior

.ColorIndex = colors(nomer) ' Установка заливки

.Pattern = xlSolid ' для ячейки

End With

End If

End If

Next

Range("a5").Select

End Sub

Private Sub Worksheet_Activate()

N_Ned = 0

 While Worksheets(2).Cells(N_Ned + 2, 3).Value <> ""

N_Ned = N_Ned + 1

 Wend

 

L1.Clear

For i = 1 To N_Ned

L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

Next

If L1.ListCount > 0 And Sav1 < L1.ListCount Then

 L1.ListIndex = Sav1

End If

End Sub

Private Sub Worksheet_Deactivate()

 Sav1 = L1.ListIndex

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

' Вычисление строки и столбца выделенной ячейки

stroka = ActiveCell.Row

stolbec = ActiveCell.Column

If stolbec <> 1 Then

' Информационное окно видимо только при выделении первой колонки

Inf1.Visible = False

ElseIf stroka > 6 Then

Inf1.Visible = True

Inf1.Text = "Вместимость " + _

Str(Worksheets(2).Cells(stroka - 5, 2)) + "чел"

End If

End Sub

 

Процедуры листа отчет 3

Private Sub Com_2_Click()

' Номера строки и столбца выделенной заявки

NumStr = ActiveCell.Row

NumCol = ActiveCell.Column

If NumStr < 7 Or NumCol < 2 Then

Exit Sub

End If

Vrem = CStr(Cells(6, NumCol)) ' Вычисление времени и дня времени занятия

Den = CStr(Cells(5, NumCol))

aud = CStr(Cells(NumStr, 1))

ColZ = 0 ' Подсчет заявок в выделенной ячейке

N = 0 ' Подсчет количества заявок на первом листе

While Worksheets(1).Cells(N + 4, 1).Value <> ""

N = N + 1

Wend

For i = 1 To N ' Цикл по количеству заявок

Day1 = CStr(Worksheets(1).Cells(i + 3, 4).Value)

Time1 = CStr(Worksheets(1).Cells(i + 3, 5).Value)

Aud1 = CStr(Worksheets(1).Cells(i + 3, 8).Value)

indicator = 0

If Time1 = Vrem And Day1 = Den And aud = Aud1 Then

For j = CInt(L1.Text) To CInt(L2.Text)

If Worksheets(1).Cells(i + 3, 11 + j).Value = "*" Then

'indicator = 1

ColZ = ColZ + 1

mZ(ColZ) = i + 3

Exit For

End If

Next

End If

Next

Cells(NumStr, NumCol).Select

With Selection.Interior

.ColorIndex = 38

.Pattern = xlSolid

End With

End Sub

Private Sub Com_3_Click()

 row7 = ActiveCell.Row ' Вычисление номера столбца и строки

 col7 = ActiveCell.Column

 Symma = Cells(NumStr, NumCol).Value ' Итоговая сумма копируемой ячейки

 N = 0 ' Вычисление числа строк на первом листе

 While Worksheets(1).Cells(N + 4, 1).Value <> ""

N = N + 1

 Wend

 NNa = 0 ' Число аудиторий на первом листе

 While Worksheets(2).Cells(NNa + 2, 1).Value <> ""

NNa = NNa + 1

 Wend

 audN = CStr(Cells(row7, 1)) ' Значения аудитории, дня и времени выделенной

 denN = CStr(Cells(5, col7)) ' ячейки

 vremZ = CStr(Cells(6, col7))

 flagZ = 0 'Индикатор возможности перемещения заявок

 For i = 4 To N + 3 ' Проверка занятий

For j = 1 To ColZ

If i = mZ(j) Then

GoTo Nexti2 ' Обходим копируемую заявку

End If

Next

a_i = CStr(Worksheets(1).Cells(i, 8).Value)

d_i = CStr(Worksheets(1).Cells(i, 4).Value)

v_i = CStr(Worksheets(1).Cells(i, 5).Value)

o_i = CStr(Worksheets(1).Cells(i, 7).Value)

If o_i <> "да" Then ' Если заявка необслужена, то ее обходим

GoTo Nexti2

End If

For j = 1 To ColZ ' Цикл по количеству перемещаемых заявок

If audN = a_i And denN = d_i And vremZ = v_i Then

' При совпадении аудитории, дня и времени

For m = 0 To 17

If Worksheets(1).Cells(i, 11 + m).Value = "*" _

And Worksheets(1).Cells(mZ(j), 11 + m).Value = "*" Then

flagZ = 1 ' Если есть перекрытие хотя бы по одной неделе,

Exit For ' то копирование невозможно

End If

Next ' Цикл по неделям

End If

If flagZ = 1 Then

Exit For

End If

Next ' Цикл по количеству перемещаемых заявок

If flagZ = 1 Then

Exit For

End If

Nexti2: Next ' Завершение проверки

If flagZ = 1 Then ' Если копирование невозможно, то выводим соответствующее сообщение

MsgBox ("Заявку не удается перенести. Аудиторное время занято.")

Max1 = CInt(L2.Text) - CInt(L1.Text) + 1

porog1 = CInt(Max1 / 2)

row7 = NumStr

col7 = NumCol

a = CInt(Cells(row7, col7).Value)

If a = 0 Then

ElseIf a = Max1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 7

.Pattern = xlSolid

End With

ElseIf a <= porog1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 8

.Pattern = xlSolid

End With

ElseIf a > porog1 And a < Max1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 15

.Pattern = xlSolid

End With

End If

Exit Sub

End If

'Цикл по количеству копированных заявок

Worksheets(1).Unprotect

For ia = 1 To ColZ

 Nom = 0

 While Worksheets(1).Cells(Nom + 4, 1).Value <> ""

Nom = Nom + 1

 Wend

 Worksheets(1).Cells(Nom + 4, 1).Value = Worksheets(1).Cells(mZ(ia), 1).Value

 Worksheets(1).Cells(Nom + 4, 2).Value = Worksheets(1).Cells(mZ(ia), 2).Value

 Worksheets(1).Cells(Nom + 4, 3).Value = Worksheets(1).Cells(mZ(ia), 3).Value

 Worksheets(1).Cells(Nom + 4, 4).Value = denN

 Worksheets(1).Cells(Nom + 4, 5).Value = vremZ

 Worksheets(1).Cells(Nom + 4, 6).Value = Worksheets(1).Cells(mZ(ia), 6).Value

 Worksheets(1).Cells(Nom + 4, 7).Value = Worksheets(1).Cells(mZ(ia), 7).Value

 Worksheets(1).Cells(Nom + 4, 8).Value = audN

 For uo = 9 To 28

Worksheets(1).Cells(Nom + 4, uo).Value = Worksheets(1).Cells(mZ(ia), uo).Value

 Next

Next

' Завершение цикла по количеству копированных заявок

' Удаление заявок

For oi = ColZ To 1 Step -1

i = mZ(oi)

Worksheets(1).Rows(i).Delete

Next

Worksheets(1).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Cells(NumStr, NumCol).Value = "0"

Cells(NumStr, NumCol).Select

With Selection.Interior

.ColorIndex = 0

.Pattern = xlSolid

End With

Max1 = CInt(L2.Text) - CInt(L1.Text) + 1

porog1 = CInt(Max1 / 2)

Cells(row7, col7).Value = Symma

If Symma = 0 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 7

.Pattern = xlSolid

End With

ElseIf Symma = Max1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 7

.Pattern = xlSolid

End With

ElseIf Symma <= porog1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 8

.Pattern = xlSolid

End With

ElseIf Symma > porog1 And Symma < Max1 Then

Cells(row7, col7).Select

With Selection.Interior

.ColorIndex = 15

.Pattern = xlSolid

End With

End If

End Sub

Private Sub CommandButton1_Click()

' Очистка области листа со старыми данными

 Range("a5:AZ100").Select

 Selection.ClearContents

 Range("a1").Select

' Убираем с экрана информационное окно

 T1.Visible = False

 ' Подсчет количества учебный дней в неделе

 N_Days = 0

 While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""

N_Days = N_Days + 1

 Wend

 ' Подсчет количества занятий в течение дня

 N_Times = 0

 While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""

N_Times = N_Times + 1

 Wend

 ' Подсчет количества аудиторий

 N_Rooms = 0

 While Worksheets(2).Cells(N_Rooms + 2, 1).Value <> ""

N_Rooms = N_Rooms + 1

 Wend

 ' Расчет количества занятий в течение недели

 DaysTimes = N_Days * N_Times

 For i = 1 To DaysTimes

For j = 1 To N_Rooms

Cells(6 + j, i + 1) = 0

Next

 Next

 ' Подсчет числа заявителей

 N_Boss = 0

 While Worksheets(2).Cells(N_Boss + 2, 6).Value <> ""

N_Boss = N_Boss + 1

 Wend

 Range("b7:AZ100").Select ' Заливка белым цветом области вывода

 With Selection.Interior

.ColorIndex = 0

.Pattern = xlSolid

 End With

 ' Подсчет количества строк на 1-м листе

 N = 0

 While Worksheets(1).Cells(N + 4, 1).Value <> ""

N = N + 1

 Wend

 ' Вывод информации начинаем с седьмой строки

 stroka = 7

 For i = 1 To N_Rooms ' Заполнение столбца аудиторий

Cells(stroka, 1).Value = Worksheets(2).Cells(i + 1, 1).Value

stroka = stroka + 1

Next

St = 1 ' Заполнение дней и начала занятий

For i = 1 To N_Days

For j = 1 To N_Times

St = St + 1

Cells(5, St).Value = Worksheets(2).Cells(i + 1, 4).Value

Cells(6, St).Value = Worksheets(2).Cells(j + 1, 5).Value

Next

Next

N_Ayd = 0 ' Подсчет аудитоий занесенных на этот лист

While Cells(N_Ayd + 7, 1).Value <> ""

N_Ayd = N_Ayd + 1

Wend

For j = CInt(L1.Text) To CInt(L2.Text) ' Цикл по указанным неделям

For i = 4 To N + 3 ' Цикл по строкам первого листа

If CStr(Worksheets(1).Cells(i, 7).Value) = _

 "да" Then ' Если заявка обслужена

Nayd = Worksheets(1).Cells(i, 8).Value

stroka = 0

For m = 1 To N_Rooms

If CStr(Nayd) = CStr(Cells(m + 6, 1).Value) Then

stroka = m + 6

Exit For

 End If

Next

' Если не найдена аудитория указанная в строке на первом листе

If stroka = 0 Then

inform_text = "Ошибка в данных в строке " + CStr(i)

MsgBox (inform_text)

'Worksheets(1).Cells(i, 1).Activate

Range("A1").Select

Exit Sub

End If

For m = 1 To DaysTimes

If CStr(Worksheets(1).Cells(i, 4).Value) = CStr(Cells(5, 1 + m).Value) _

And CStr(Worksheets(1).Cells(i, 5).Value) = CStr(Cells(6, 1 + m).Value) Then

stolbec = 1 + m

Exit For

End If

Next

' Фрагмент для учета групповых занятий

If Worksheets(1).Cells(i, j + 11).Value = "*" And Cells(stroka, stolbec).Value < 1000 Then

Cells(stroka, stolbec) = Cells(stroka, stolbec) + 1

Cells(stroka, stolbec) = Cells(stroka, stolbec) + 1000

End If

End If

 Next

 For ii = 1 To DaysTimes

For jj = 1 To N_Rooms

a = CInt(Cells(jj + 6, ii + 1).Value)

If a >= 1000 Then

Cells(jj + 6, ii + 1).Value = Cells(jj + 6, ii + 1).Value - 1000

End If

Next

 Next

Next

' Расцветка занятий

 Maximum = CInt(L2.Text) - CInt(L1.Text) + 1

 porog = CInt(Maximum / 2) ' Порог - половина занятых дней в указанном интервале

For i = 1 To DaysTimes

For j = 1 To N_Rooms

a = CInt(Cells(j + 6, i + 1).Value) ' Количество занятий

If a = Maximum Then

Cells(j + 6, i + 1).Select

With Selection.Interior

.ColorIndex = 7 ' Расцветка при максимальной занятости

.Pattern = xlSolid

End With

ElseIf a <= porog And a > 0 Then

Cells(j + 6, i + 1).Select

With Selection.Interior

.ColorIndex = 8 ' Расцветка при знятости меньше среней

.Pattern = xlSolid

End With

ElseIf a > porog And a < Maximum Then

Cells(j + 6, i + 1).Select

With Selection.Interior

.ColorIndex = 15

.Pattern = xlSolid

End With

End If

Next

Next

 Range("a5").Select

 T1.Visible = True

 End Sub

Private Sub CommandButton2_Click()

F_Podbor.Show

End Sub

Private Sub T1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

T1.Text = ""

T1.Visible = False

End Sub

Private Sub Worksheet_Activate()

N_Ned = 0

 While Worksheets(2).Cells(N_Ned + 2, 3).Value <> ""

N_Ned = N_Ned + 1

 Wend

 

L1.Clear

L2.Clear

For i = 1 To N_Ned

 L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

 L2.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

If L1.ListCount > 0 And Sav1 < L1.ListCount Then

 L1.ListIndex = Sav1

End If

If L2.ListCount > 0 And Sav2 < L2.ListCount Then

 L2.ListIndex = Sav2

End If

Private Sub Worksheet_Deactivate()

Sav1 = L1.ListIndex

Sav2 = L2.ListIndex

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

NumStr1 = ActiveCell.Row

NumCol1 = ActiveCell.Column

If NumCol1 <> 1 Then

If T1.Visible = False Then

Exit Sub

End If

T1.Text = ""

N_Days = 0

While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""

N_Days = N_Days + 1

Wend

N_Times = 0

While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""

N_Times = N_Times + 1

Wend

' Количество строк

DaysTimes = N_Days * N_Days

N = 0

While Worksheets(1).Cells(N + 4, 1).Value <> ""

N = N + 1

Wend

'Цикл по строкам первого листа

For i = 1 To N

 Day1 = CStr(Worksheets(1).Cells(i + 3, 4).Value)

 Time1 = CStr(Worksheets(1).Cells(i + 3, 5).Value)

 Group1 = CStr(Worksheets(1).Cells(i + 3, 9).Value)

 Prepod1 = CStr(Worksheets(1).Cells(i + 3, 3).Value)

 Disp1 = CStr(Worksheets(1).Cells(i + 3, 10).Value)

 Aud1 = CStr(Worksheets(1).Cells(i + 3, 8).Value)

 Obs1 = CStr(Worksheets(1).Cells(i + 3, 7).Value)

 ' Если заявка обслужена

If Obs1 = "да" Then

indic = 0

For j = CInt(L1.Text) To CInt(L2.Text)

If CStr(Worksheets(1).Cells(i + 3, 10 + j).Value) = "*" Then

indic = 1

Exit For

End If

Next

' Если интервал недель соответстует

If indic = 1 Then

If Day1 = CStr(Cells(5, NumCol1).Value) And _

Time1 = CStr(Cells(6, NumCol1).Value) _

And CStr(Cells(NumStr1, 1).Value) = Aud1 Then

If T1.Text <> "" Then

T1.Text = T1.Text + Chr(10)

End If

T1.Text = T1.Text + Disp1

T1.Text = T1.Text + " " + Group1

T1.Text = T1.Text + " " + Prepod1 + " "

For j = CInt(L1.Text) To CInt(L2.Text) 'Цикл 1

ask = CStr(Worksheets(1).Cells(i + 3, j + 11).Value)

If ask = "*" Then

T1.Text = T1.Text + " " + Str(j) + ","

End If

Next

End If

End If ' Если интервал недель соответстует

End If 'Если заявка обслужена

Next 'Завершение цикла по строкам первого листа

T3.Visible = False

ElseIf NumStr1 > 6 Then

T3.Visible = True

T3.Text = "Вместимость " + Str(Worksheets(2).Cells(NumStr1 - 5, 2)) + " чел "

End If

End Sub

Приложение 2

 

Процедура, связанная с открытием книги

Private Sub Workbook_Open()

 ' Подсчет дней на втором листе

 N_Days = 0

 While Worksheets(2).Cells(N_Days + 2, 4).Value <> ""

N_Days = N_Days + 1

 Wend

 ' Заполнение списка L1 на 3-м листе

 Worksheets(3).L1.Clear

 For i = 1 To N_Days

Worksheets(3).L1.AddItem Worksheets(2).Cells(i + 1, 4).Value

 Next

 ' Подсчет занятий в течение дня

 N_Times = 0

 While Worksheets(2).Cells(N_Times + 2, 5).Value <> ""

N_Times = N_Times + 1

 Wend

 ' Заполнение списка L2 на 3-м листе

 Worksheets(3).L2.Clear

 For i = 1 To N_Times

Worksheets(3).L2.AddItem CStr(Worksheets(2).Cells(i + 1, 5).Value)

 Next

' Подсчет числа недель на втором листе

N_Ned = 0

 While Worksheets(2).Cells(N_Ned + 2, 3).Value <> ""

N_Ned = N_Ned + 1

 Wend

 ' Заполнение 3-го списка L3 на 3-м листе

 Worksheets(3).L3.Clear

 For i = 1 To N_Ned

Worksheets(3).L3.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

' Заполнение списков недель на 4-м листе

 Worksheets(4).C1.Clear

 Worksheets(4).C2.Clear

 For i = 1 To N_Ned

Worksheets(4).C1.AddItem Worksheets(2).Cells(i + 1, 3).Value

Worksheets(4).C2.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

 ' Заполнение списка недель на 8-м листе

 Worksheets(8).L1.Clear

 For i = 1 To N_Ned

Worksheets(8).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

 ' Заполнение списка недель на 9-м листе

 Worksheets(9).L1.Clear

 Worksheets(9).L2.Clear

 For i = 1 To N_Ned

Worksheets(9).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

Worksheets(9).L2.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

 'Заполнение списка недель на 10-м листе

 Worksheets(10).L1.Clear

 Worksheets(10).L2.Clear

 For i = 1 To N_Ned

Worksheets(10).L1.AddItem Worksheets(2).Cells(i + 1, 3).Value

Worksheets(10).L2.AddItem Worksheets(2).Cells(i + 1, 3).Value

 Next

 ' Подсчет числа преподавателей

 N_Prepod = 0

 While Worksheets(2).Cells(N_Prepod + 2, 7).Value <> ""

N_Prepod = N_Prepod + 1

 Wend

 ' Заполнение списка преподавателей на листе Нагрузка

 Worksheets(12).Prepod.Clear

 For i = 1 To N_Prepod

Worksheets(12).Prepod.AddItem Worksheets(2).Cells(i + 1, 7).Value

 Next

 Worksheets(11).mesac.Clear

Worksheets(11).mesac.AddItem "сентябрь"

Worksheets(11).mesac.AddItem "октябрь"

Worksheets(11).mesac.AddItem "ноябрь"

Worksheets(11).mesac.AddItem "декабрь"

Worksheets(11).mesac.AddItem "январь"

Worksheets(11).mesac.AddItem "февраль"

Worksheets(11).mesac.AddItem "март"

Worksheets(11).mesac.AddItem "апрель"

Worksheets(11).mesac.AddItem "май"

Worksheets(11).mesac.AddItem "июнь"

' Установка защиты на первый и второй листы

 Worksheets(1).Protect DrawingObjects:=True, Contents:=True, _

Scenarios:=True

 Worksheets(2).Protect DrawingObjects:=True, Contents:=True, _

Scenarios:=True

End Sub

СПИСОК ЛИТЕРАТУРЫ

1 Смирнов Г.Н. «Проектирование экономических информационных систем». Учебник.-М.: Финансы и статистика, 2003.

2. Емельянова Н.З. и др. «Основы построения автоматизированных систем». Учебное пособие. – М.: Форум: ИНФРА-М,2005.

3. Гарнаев А.Ю. «Самоучитель VBA.» СПБ.:БХВ-Петеребург,2004.

4. Уокенбах Д. «Профессиональное программирование на VBA в Exel 2002».: Перевод с английского. – М.: Издательский дом «Вильямс», 2003