 |
Чтобы убрать это текстовое окно с экрана, нужно сделать в нем двойной щелчок.
|
|
|
|
На листе для работы с отчетом заложена еще одна интересная возможность, связанная с двумя кнопками — Подготовить к перемещению и Переместить. С помощью этих кнопок можно перемещать занятия из одних аудиторий в другие. Для этого нужно выделить исходную ячейку и щелкнуть на кнопке Подготовить к перемещению — информация о заявке по указанной ячейке зафиксируется во внутренней структуре данных (буфере). После этого пользователю нужно лишь выделить ячейку, куда он намеревается перенести занятие, и щелкнуть на кнопке Переместить.
В результате таких простых действий в отчете произошли изменения на первом листе заявок. Исходная заявка удалена, но при этом появилась.
Заметим, что алгоритм переноса заявки в новую аудиторию характеризуется определенным "интеллектом". Перед переносом заявки сначала анализируется возможность переноса — нет ли в этой аудитории занятий в рассматриваемые интервалы недель. Например, если мы переносим две заявки (в одной ячейке может быть несколько занятий, если они проводятся в разные недели) из одной аудитории в другую, то в случае невозможности переноса одной из них эта заявка остается без изменений.
Рассмотренный отчет, таким образом, кроме получения наглядной сводной информации по загрузке, позволяет оперативно менять аудитории в составленном расписании. Из отчета при необходимости можно быстро найти свободные классы для занятий и планировать циклы дисциплин на определенное время.
2.1.3.1 Блок – схема интерфейса
1
БД
2
таблица
3
связи
4
сервис
5
|
|
|
Справка 6
7
выход 8
2.1.3.2. Описание блок – схемы интерфейса
1. НАЧАЛО
2. Проверка условия, если условие истинно, то идем на блок _
3. Проверка условия, если условие истинно, то идем на блок _
3. Проверка условия, если условие истинно, то идем на блок _
4. Проверка условия, если условие истинно, то идем на блок _
5. Проверка условия, если условие истинно, то идем на блок
6. Проверка условия, если условие истинно, то идем на блок _
7. Проверка условия, если условие истинно, то идем на блок _
8. КОНЕЦ
2.2 Описание процесса отладки программы
Ошибки при работе над проектом, особенно сложным и большим, неизбежны. Поэтому при создании проекта важным этапом является отладка приложения. Отладка — непременный этап работы над любым проектом. Как правило, это проверка функционирования проекта и исправление ошибок перед передачей его на тестирование. Для выполнения отладки в Visual Basic 6 существует набор специальных инструментов, который рассматривается в этой главе. Редактор кода.
Редактор кода программы Visual Basic 6 — это достаточно мощный текстовый редактор с большим количеством возможностей и являющийся основным инструментом программиста для создания и отладки приложения. В окне редактора представлены следующие элементы управления:
раскрывающийся список Object (Объект) — обеспечивает выбор объектов приложения. Этот список находится в левом верхнем углу окна редактора. При выборе объекта в этом списке синхронно изменяется содержимое списка Procedure;
раскрывающийся список Procedure (Процедура) дает возможность выбора членов объекта (событий) и автоматического вывода процедуры или шаблона для выбранного члена в окне редактора. Этот список находится справа от списка Object; кнопка Procedure View (Просмотр процедур) — включает режим просмотра процедур для каждого объекта по отдельности. Располагается в левом, нижнем углу окна редактора;
|
|
|
кнопка Full Module View (Полный просмотр модулей) — включает режим работы полного просмотра процедур, при котором в окне редактора показаны все процедуры, разделенные горизонтальной линией (если установлен соответствующий флаг настройки). Располагается в левом нижнем углу окна редактора;
горизонтальная и вертикальная полосы прокрутки — позволяют просмотреть текст, который не помещается в текущем окне редактора.
Как можно понять из списка элементов управления, редактор кода работает в двух режимах: в режиме просмотра всего текста приложения (полный просмотр процедур) и в режиме просмотра процедур по отдельности (просмотр отдельных процедур). Редактор кода вызывается автоматически при двойном щелчке мыши на форме проекта или командой Code (Код) меню View (Вид). Для каждого элемента проекта (формы или программного модуля) открывается отдельное окно редактора кода. Соответственно это окно появляется в списке окон меню Window (Окно). В большом проекте удобнее всего работать из Проводника проекта. В этом случае редактор кода вызывается кнопкой View Code (Просмотр кода) панели инструментов окна Проводника.
2.3 Характеристика программы
Данная программа написана на языке Visual Basic 6.0 и представляет собой 1 приложением, предназначенных выполнять все функции, которые требуются заданию. В конечный продукт входит 1 откомпилированное приложения, размер которого составляет соответственно 892 байт. Для работы необходимы следующие системные ресурсы: Прежде чем приступить к работе с данной системой, необходимо иметь: компьютер, совместимый с IBM PC с тактовой частотой процессора не менее 1500 MHz; оперативную память 256 Mb; жесткий диск объемом 40 Mb; видеоадаптер SVGA с объемом оперативной памяти 128 Mb.
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
|
|
|
