47889 (608403), страница 17
Текст из файла (страница 17)
Для запуска программы необходимо выполнить следующие действия. Нажать кнопку пуск в панели задач; И наитии программу 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)
![](https://s.studizba.com/z.php?f=/templates/si/i/noavatar.png&w=100&h=100&t=1"){kind=avatar}
