Главная | Обратная связь | Поможем написать вашу работу!
МегаЛекции

Чтобы убрать это текстовое окно с экрана, нужно сделать в нем двойной щелчок.

На листе для работы с отчетом заложена еще одна интересная возможность, связанная с двумя кнопками — Подготовить к перемещению и Переместить. С помощью этих кнопок можно перемещать занятия из одних аудиторий в другие. Для этого нужно выделить исходную ячейку и щелкнуть на кнопке Подготовить к перемещению — информация о заявке по указанной ячейке зафиксируется во внутренней структуре данных (буфере). После этого пользователю нужно лишь выделить ячейку, куда он намеревается перенести занятие, и щелкнуть на кнопке Переместить.

В результате таких простых действий в отчете произошли изменения на пер­вом листе заявок. Исходная заявка удалена, но при этом появилась.

Заметим, что алгоритм переноса заявки в новую аудиторию характеризуется определенным "интеллектом". Перед переносом заявки сначала анализирует­ся возможность переноса — нет ли в этой аудитории занятий в рассматри­ваемые интервалы недель. Например, если мы переносим две заявки (в одной ячейке может быть несколько занятий, если они проводятся в разные недели) из одной аудитории в другую, то в случае невозможности переноса одной из них эта заявка остается без изменений.

Рассмотренный отчет, таким образом, кроме получения наглядной сводной информации по загрузке, позволяет оперативно менять аудитории в состав­ленном расписании. Из отчета при необходимости можно быстро найти свободные классы для занятий и планировать циклы дисциплин на опреде­ленное время.

 

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

Поделиться:





Воспользуйтесь поиском по сайту:



©2015 - 2024 megalektsii.ru Все авторские права принадлежат авторам лекционных материалов. Обратная связь с нами...