«ДЕКАНАТ»

Возможности системы

· Подготовка и выполнение контроля учебного процесса студентов (формирование учебных планов, подготовка рабочих программ);

· Организация процедуры приема студентов (от приема документов, через проведение вступительных испытаний с конкурсным отбором по их итогам, до формирования представления к зачислению);

· Сопровождение процессов обучения студента в ВУЗ-е (переводы, отчисления, оценки, задолженности и т.д.);

· Обеспечение процесса выпуска студентов (проведение государственных аттестаций, защиты дипломных проектов, подготовку и печать дипломов, академических справок и т.д.);

· Формирование различных документов с поименным составом входящих в них преподавателей (заседаний комиссий, ведомостей и т.д.);

· Анализ различных аспектов учебного процесса (сверка выполнения учебных планов, движение, успеваемость и т.д.)

« РЕКТОР »

Ректор 3 - программа для составления расписания в средних школах.

Ректор-Школа - программа для составления расписания в средних школах с профильным обучением.

Программы позволяют быстро и удобно вводить все дисциплины, классы, нагрузки учителей, взаимосвязи уроков, кабинеты. Она позволяет создать группы, объединить несколько классов в один урок и иметь уроки, обучаемые через две недели. Возможно определить и большее количество учителей для одного урока. Мы можем выбрать точный интервал времени для каждой дисциплины, класса, кабинета и учителя. Например можно определить, что Математика не может быть 6-ым уроком, учительница Иванова не может обучать 6-ой урок во вторник и 3-ий в среду, и спортзал должен быть свободен в течение 4-ых и 5-ых уроков, так как в эти дни приходят тренироваться ученики спорт-школы. [ 21,22] Программа соблюдает все заданные условия:

· Число окон для учителей, ограничение максимального числа окон, ограничение дней, когда преподаватель может обучать.

· Равномерное распределение дисциплин в течений недели

· Проверка последовательности уроков полных и разделенных классов

· Размещение уроков в кабинеты

· И много больше ...

Ректор-Колледж - программа для составления расписания в средних специальных учебных заведениях.

Ректор-ВУЗ - программа для составления расписания в ВУЗах.

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

СИСТЕМНЫЕ ТРЕБОВАНИЯ

Операционная система - MS Windows XP или MS Vista.

Объем оперативной памяти - 512 Мб или выше.

Свободное место на жестком диске - не менее 100 Мб.

Рекомендуемая глубина цвета, поддерживаемая видеокартой и монитором - 16 разрядов (бит) или больше.

Минимальное разрешение монитора - 1024 x 768.

Мышь - не менее двух кнопок.

Система АВТОР-2+

Система АВТОР-2+ предназначена для быстpого и удобного составления расписаний занятий и сопровождения их в течение всего учебного года. АВТОР-2+ - универсальная система. Есть несколько версий программы, рассчитанные на любые учебные заведения:

- сpедние и специализиpованные (математические, языковые и т.п.) школы, лицеи, гимназии;

- техникумы, училища и колледжи;

- ВУЗы с одним учебным корпусом;

- ВУЗы с несколькими учебными корпусами (с учетом переездов между корпусами).

АВТОР-2+ позволяет максимально облегчить и автоматизиpовать сложный тpуд составителей расписания. Система помогает легко стpоить, коppектиpовать и pаспечатывать в виде удобных и наглядных документов:

- pасписания занятий классов (учебных групп);

- расписания пpеподавателей;

- расписание аудиторий (кабинетов);

- учебные планы;

- тарификацию.

АВТОР-2+ имеет пpиятный дизайн и дpужеcтвенный сеpвис. Программа достаточно проста в освоении. Имеется подробное руководство, в котором описаны все возможности и способы работы с программой. Программа работает на любых IBM-совместимых компьютерах, начиная с 486DX с оперативной памятью 516Mb (и выше), занимает около 75 Mb на жестком диске. Операционная система: WINDOWS XP. Время работы зависит от размерности учебного заведения и мощности компьютера. Полный расчет и оптимизация расписания школы среднего размера (30 классов, 60 преподавателей, две смены) идет около 5 минут на компьютере типа Celeron-1700.

Программа отличается уникальным и очень мощным алгоритмом построения и оптимизации расписания. Полученное автоматическое расписание практически не требует ручной доработки, то есть даже при очень сложных и жестких ограничениях автоматически размещаются все возможные занятия. Если в исходных данных имеются неразрешимые противоречия, то их можно обнаружить и устранить, используя специальный блок анализа.

АВТОР-2+ позволяет:

- оптимизировать "окна" в расписании;

- учитывать требуемый диапазон дней/часов как для классов, так и для преподавателей;

- оптимально pазмещать занятия по кабинетам (аудиториям) с учетом особенностей классов, предметов, пpеподавателей и вместимости кабинетов;

- учитывать хаpактеp pаботы и пожелания как штатных сотpудников, так и совместителей-почасовиков;

- легко соединять ("спаpивать") несколько классов (учебных групп) в потоки пpи пpоведении любых занятий;

- pазделять классы пpи пpоведении занятий по иностранному языку, физической культуре, тpуду, информатике (и любым другим предметам) на любое количество подгрупп (до десяти!);

- вводить (помимо основных пpедметов) спецкуpсы и факультативы;

- оптимизировать равномерность и трудоемкость расписания.

По желанию заказчика АВТОР-2+ модифициpуется под условия конкретного учебного заведения.

Система “Расписание” ver 4.0 Москва - ЛинТех

Необходимо сразу же отметить, что программа “Расписание” ориентирована на составление школьного расписания, использование в ВУЗ`ах и колледжах возможно лишь с некоторыми оговорками. Составление расписания производится в рамках комплекса условий, которые определяются на шагах ввода исходных данных. Полный перечень возможных условий приведен ниже:

- Ограничен максимальный номер урока - т.е. количество уроков, максимально допустимое в день;

- Равномерность распределения нагрузки преподавателей между днями расписания;

- Равномерность распределения нагрузки классов между днями расписания;

- Контроль окон в расписании преподавателей;

- Программа учитывает то обстоятельство, что классы могут произвольно объединяться и дробиться (классы могут объединяться в потоки или же дробиться на более мелкие подгруппы, причем эти подгруппы, в свою очередь, могут служить основой для объединения в более крупные группы. Пример: в школе №1859 есть 2 старших класса, но в каждом из этих классов есть две подгруппы по специализации, занятия по общеобразовательным предметам проводятся сразу для всего класса, а предметы по специализации - отдельно. Но поскольку подгруппы по специализации слишком малы, а преподавателей не хватает, по некоторым предметам подгруппы 11а и 11б также могут объединяться (например, на ин.яз.) - это усложняет обеспечении непрерывности расписания для классов (необходимо обеспечивать непрерывность расписания для каждой из подгрупп);

- Наличие нескольких смен - в этом случае отдельные классы должны приходить позже, чем группы первой смены, кроме этого, усложняется контроль окон в расписании преподавателей, если есть преподаватели, работающие в обе смены - в этом случае в расписании этих преподавателей их занятия необходимо “стягивать” вокруг пересечения смен;

- Условие привязки преподавателей к аудитории - отдельные преподаватели имеют “свою” аудиторию, в которой проводят все свои занятия;

- Наличие “плавающей” смены - когда время начала первого урока точно не определено, т.к. оно формируется динамически, в зависимости от освобождения связанных с соответствующим классов, преподавателей, аудиторий;

- Контроль вхождения расписания объекта (класс, преподаватель, аудитория) в допустимый рабочий диапазон (в карту временных ограничений). Например, для преподавателя в карте временных ограничений обычно указываются методические дни, иногда, отдельные номера уроков - словом, указываются те позиции, на которые установка занятий с участием данного объекта невозможна;

- Наличие комбинированных предметов - типа “ин.яз./информатика” “информатика/труд” и т.п. - когда класс разбивается на подгруппы;

- Условие привязки предметов к аудиториям - проведения занятий по отдельным предметам возможно лишь в строго определенной аудитории или списке аудиторий (физкультура, труд и т.п.);

- Составление расписания с учетом того обстоятельства, что по некоторым предметам на занятия приходит не целый класс, а его подгруппа. Чтобы другая подгруппа в это время не гуляла по школе, такие занятия могут ставиться строго только первыми или последними занятиями в расписании класса;

- “Выдержать параллели” - для некоторых преподавателей необходимо учитывать то обстоятельство, что для проведения занятий требуется длительная подготовка (например, занятия по химии), в этом случае занятия в дневном расписании преподавателя стараются поставить блоками параллелей, например, сначала 5-ые классы, затем 7-ые и т.п., или же при распределении между днями разнести занятия в разных параллелях на разные дни;

- Иногда при составлении расписания требуется учитывать тот нюанс, что по некоторым предметам расписание известно заранее -в этом случае такие занятия вводятся как неперемещаемые (фиксированные);

- Контроль запрещенных комбинаций предметов, приходящихся на один день расписания класса - например, нежелательно, чтобы “физическая культура” и “труд” проводились в один и тот же день;

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

- Наличие классов, привязанных к аудиториям - основная масса занятий для таких классов проводится именно в этой аудитории, за исключением тех занятий, для которых требуется специализированная аудитория;

- Необходимость расстановки занятий по отдельным предметам по два занятия подряд (“парами”, “спарками”), причем это условие может быть жестким (ни в коем случае не разрывать “спарки” занятий), а может носить предпочтительный характер (если не получается перемещать по два занятия, “спарку” можно разрывать);

- Учитывается то обстоятельство, когда по некоторым предметам расстановка допустима лишь одиночными занятиями.

Система “Методист”

Выпускается в двух версиях.

Версия virtual.

Выпускается без модуля автоматического составления расписания. Возможности версии virtual:

- быстрый поиск в списках преподавателей, аудиторий, классов (групп), дисциплин, корпусов;

- получение справочной информации по каждому найденному элементу списка (вместимость аудитории, все ауд. корпуса Х, адрес и тел. преподавателя, список кафедры, кол-во часов по дисциплине, учебная нагрузка преподавателя и мн. др.);

- контроль и возможность перераспределения часов между неделями по любой дисциплине уч. группы;

- автоматическая проверка возможных ошибок ввода данных (соответствие общей суммы часов и по видам занятий, неназначение преподавателей по подгруппам, бюджет времени уч. группы и преподавателя, несоответствие часов в группах потока и мн. др.);

- возможность систематизированного хранения (и быстрого поиска) дополнительной (не обязательной для составления расписания) информации: фото преподавателей, кураторы учебных групп (классные руководители), данные о представителях родительских комитетов, должности, ученые степени и звания, ответственные за аудиторию, ...

- быстрое получение полной информации по сочетанию факторов (все группы потока, все дисциплины преподавателя Х с указанием нагрузки по неделям и видам занятий, какие дисциплины разрешено проводить в компьютерном классе, личные пожелания к проведению занятий любого преподавателя, перечень праздничных дат в сирийской группе и мн. др.);

- возможность просмотра, печати и редактирования готового расписания с проверкой корректности изменений (занятость ауд., преп., групп/подгрупп, ...);

- в любой момент можно заказать модуль формирования расписания для подготовленных данных;

- расписание формируется на вашем компьютере с возможностью изменения настроек, контроля, правки и т.п. (без возможности изменения часов, дисциплин, преподавателей, ...);

- если обнаружена необходимость незначительного (до 10%) изменения исходных данных (обнаружены ошибки, внезапные дополнения), возможен повторный заказ модуля формирования расписания за незначительную плату;

- в любой момент можно перейти на версию стандарт;

Методист - стандарт.

Помимо возможностей версии virtual включает в себя:

- Модуль автоматического составления расписания;

- Распределение и контроль учебной нагрузки ;

- Учет методических рекомендаций и личных пожеланий преподавателей ("окна", метод. дни, теннис по четвергам, день рождения сына, ...);

- Cтрогое выдерживание последовательности прохождения дисциплины (лекции - 2 час., практические - 4 час., лабораторные ...);

- Составление расписания для любого типа учебного заведения: недельное или семестровое (от 1 до 23 недель);

- Учет объединения групп (классов) в потоки и/или разбиение их на подгруппы;

- Закрепление специальных аудиторий (компьютерные классы, лингафонные кабинеты, бассейн, ...);

- Учет занятости преподавателей и аудиторий (совместительство, использование общей учебной базы);

- Учет времени переходов между корпусами;

- Выходные и праздничные дни - общие и для отдельных учебных групп (национальные, религиозные, государственные праздники);

- Указание причин "неудачного назначения" занятий (занята аудитория, преподаватель назначен в нежелательный для него день недели) с возможностью их "ручного" исправления;

- Возможность многократного автоматического "улучшения" расписания;

- Возможность изменения значимости учитываемых при составлении расписания факторов;

- Возможность введения приоритетов преподавателей - степени учета их индивидуальных пожеланий;

Ограничения функциональности “Методиста”:

- многосменные расписания ограничены максимальным кол-вом уроков в день - 7;

- занятия всегда начинаются с первого урока / пары (при необходимости возможно назначение на первую пару "свободного занятия" );

- не учитывется время перемен (например для проверки возможности перехода между корпусами);

- не учитывается "уровень сложности" занятий для их рационального распределения по неделе (хотя имеется возможность делать это косвенным образом) ;

- продолжительность занятий постоянна (невозможно составление расписания для 30 мин. урока в младших и 45 мин. - в старших классах).

Приложение 2. Листинг программного модуля методов решения задачи автоматического составления расписания

iCurRow = iCurRow + 8

Next dDay

dbsDatabase.Close

'Все готово, показываем окошко

SetPageProperties xlPortrait

MyWindow.Visible = True

MyWindow.ActiveSheet.Range("A1").Select

End Sub

Sub Создать_Расписание()

Windows("Расписание.xlt").Visible = False

If Year(dSelectedDay) < 2000 Then

dSelectedDay = Now

End If

Set dbsDatabase = OpenDatabase(Workbooks("Расписание.xlt").Path & "/" & strDatabase)

Load ChooseLessonForm

PlaneItForm.Show vbModeless

'dbsDatabase.Close

End Sub

Sub Вставить_расписание()

Windows("Расписание.xlt").Visible = False

' запрашиваем дату

'res = MyDateInputBox()

'If Not IsEmpty(res) Then

' dSelectedDay = CDate(res)

'Else

' Exit Sub

'End If

Set MyWindow = ActiveWindow

'MyWindow.WindowState = xlMinimized

MyWindow.Visible = False

If Year(dSelectedDay) < 2000 Then

dSelectedDay = Now

End If

Rem Вставка расписания на текущую неделю из БД

Set dbsDatabase = OpenDatabase(Workbooks("Расписание.xlt").Path & "/" & strDatabase)

MakeMyTable

SetPageProperties

dbsDatabase.Close

MyWindow.Visible = True

'MyWindow.WindowState = xlMaximized

'MyWindow.Activate

MyWindow.ActiveSheet.Range("A1").Select

End Sub

Sub MakeMyTable()

' очистить все

MyWindow.ActiveSheet.Cells.Clear

' Заголовок расписания

MyWindow.ActiveSheet.Range("A1:AD1").ColumnWidth = 4.2

MyWindow.ActiveSheet.Range("A1:A62").RowHeight = 20

MergeCellsText "A2", "U2", "РАСПИСАНИЕ"

dStartWeekDay = dSelectedDay - Weekday(dSelectedDay, vbUseSystemDayOfWeek) + 1

MergeCellsText "A3", "U3", "занятий с " & FormatDateTime(dStartWeekDay, vbLongDate) & " по " & FormatDateTime(dStartWeekDay + 6, vbLongDate)

MergeCellsText "V1", "AB1", "УТВЕРЖДАЮ"

MergeCellsText "V2", "AB2", "начальник учебного отдела"

MyWindow.ActiveSheet.Range("W3").Formula = "подполковник"

MyWindow.ActiveSheet.Range("AA3").Formula = "В.Харичкин"

MyWindow.ActiveSheet.Range("Q50").Formula = "Старший ПНУО п/п-к"

MyWindow.ActiveSheet.Range("X50").Formula = "В.Гусельников"

Dim rstWeekday As Recordset

Dim fldHours As Field

Dim rstLessons As Recordset

Dim fldLong As Field

Dim fldName As Field

Dim fldTime As Field

Dim fldColor As Field

Dim sqlQuery As String

Dim iCurRow As Integer

Dim iCurCol As Integer

' первая часть расписания на 1-3 роты

iCurRow = 5

iCurCol = 1

For dDay = 1 To 7 'цикл по дням недели

If dDay = 4 Then

iCurRow = 29

iCurCol = 1

End If

' Запрос часов по дням

Set rstWeekday = dbsDatabase.OpenRecordset("SELECT * FROM Дни_недели WHERE день='" & WeekdayName(dDay) & "'")

Set fldHours = rstWeekday.Fields("Кол-во_часов")

iHours = fldHours.Value

rstWeekday.Close

'Заголовок для взводов

If dDay = 1 Or dDay = 4 Then

MyWindow.ActiveSheet.Cells(iCurRow, iCurCol).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address

End If

If dDay = 3 Or dDay = 7 Then

MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours + 1).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHours + 1)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours + 1).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + iHours + 1)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours + 1).Address

End If

' Расстановка часов по дням

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHours).Address

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address

For iHourCounter = 1 To iHours 'цикл по часам в дне dDay

MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHourCounter).Value = iHourCounter

MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + iHourCounter).Value = iHourCounter

Next

If dDay < 7 Then

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, WeekdayName(dDay) & " - " & FormatDateTime(dStartWeekDay + dDay - 1, vbLongDate)

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address, WeekdayName(dDay) & " - " & FormatDateTime(dStartWeekDay + dDay - 1, vbLongDate)

Else

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, WeekdayName(dDay)

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address, WeekdayName(dDay)

End If

' Расстановка взводов

For i = 1 To 3 'Роты

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + 2, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + i * 5 + 1, iCurCol + iHours).Address

With MyWindow.ActiveSheet.Range(MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + 2, iCurCol + 1).Address & ":" & MyWindow.ActiveSheet.Cells(iCurRow + i * 5 + 1, iCurCol + iHours).Address)

.Font.Name = "MS Serif"

.Font.Size = 6

End With

For j = 1 To 5 'Взвода

iPlatoon = 200 + 10 * i + j

If dDay = 1 Or dDay = 4 Then

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j + 1, iCurCol).Value = iPlatoon

End If

If dDay = 3 Or dDay = 7 Then

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j + 1, iCurCol + iHours + 1).Value = iPlatoon

End If

' Rem Поиск занятия в расписании

sqlQuery = "SELECT Предметы.Цвет, Предметы.Кратк_название & ' ' & План.Тема & '/' & IIF(АвтовставкаТем.Тема is not null,АвтовставкаТем.Тема,План.Занятие)& ' ' & План.Место_проведения AS Имя, План.Длина, Расписание.Время "

sqlQuery = sqlQuery & "FROM (((Расписание INNER JOIN План ON Расписание.Код_занятия=План.Код_занятия)"

sqlQuery = sqlQuery & "INNER JOIN Предметы ON План.Код_предмета=Предметы.Код_предмета)"

sqlQuery = sqlQuery & "LEFT JOIN [АвтовставкаТем] ON (Расписание.Дата=АвтовставкаТем.Дата AND Расписание.Код_занятия=АвтовставкаТем.Код_занятия))"

sqlQuery = sqlQuery & "WHERE Расписание.Дата=CDate('" & FormatDateTime(dStartWeekDay + dDay - 1, vbShortDate) & "') "

sqlQuery = sqlQuery & "AND Расписание.Взвод=" & Str(iPlatoon)

Set rstLessons = dbsDatabase.OpenRecordset(sqlQuery)

Do Until rstLessons.EOF

Rem занятие найдено, устанавливаем длину и название ячейки

Set fldName = rstLessons.Fields("Имя")

Set fldLong = rstLessons.Fields("Длина")

Set fldTime = rstLessons.Fields("Время")

Set fldColor = rstLessons.Fields("Цвет")

With MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j + 1, iCurCol + fldTime.Value)

MergeCellsText .Address, .Offset(0, fldLong.Value - 1).Address, fldName.Value расписание учебный информационный модель

If Not IsNull(fldColor) Then

If fldColor.Value > 0 Then MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j + 1, iCurCol + fldTime.Value).Interior.Color = fldColor.Value

End If

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j + 1, iCurCol + fldTime.Value).WrapText = True

End With

rstLessons.MoveNext

Loop

rstLessons.Close

Next j

Next i

iCurCol = iCurCol + iHours

Next dDay

' вторая часть расписания на 4-6 роты

' Заголовок расписания

MyWindow.ActiveSheet.Range("A55:AD55").ColumnWidth = 4.2

MyWindow.ActiveSheet.Range("A55:A116").RowHeight = 20

MergeCellsText "A56", "U56", "РАСПИСАНИЕ"

dStartWeekDay = dSelectedDay - Weekday(dSelectedDay, vbUseSystemDayOfWeek) + 1

MergeCellsText "A57", "U57", "занятий с " & FormatDateTime(dStartWeekDay, vbLongDate) & " по " & FormatDateTime(dStartWeekDay + 6, vbLongDate)

MergeCellsText "V55", "AB55", "УТВЕРЖДАЮ"

MergeCellsText "V56", "AB56", "начальник учебного отдела"

MyWindow.ActiveSheet.Range("W57").Formula = "подполковник"

MyWindow.ActiveSheet.Range("AA57").Formula = "В.Харичкин"

MyWindow.ActiveSheet.Range("Q104").Formula = "Старший ПНУО п/п-к"

MyWindow.ActiveSheet.Range("X104").Formula = "В.Гусельников"

iCurRow = 59

iCurCol = 1

For dDay = 1 To 7 'цикл по дням недели

If dDay = 4 Then

iCurRow = 83

iCurCol = 1

End If

' Запрос часов по дням

Set rstWeekday = dbsDatabase.OpenRecordset("SELECT * FROM Дни_недели WHERE день='" & WeekdayName(dDay) & "'")

Set fldHours = rstWeekday.Fields("Кол-во_часов")

iHours = fldHours.Value

rstWeekday.Close

'Заголовок для взводов

If dDay = 1 Or dDay = 4 Then

MyWindow.ActiveSheet.Cells(iCurRow, iCurCol).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address

End If

If dDay = 3 Or dDay = 7 Then

MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours + 1).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHours + 1)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours + 1).Value = "№"

With MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + iHours + 1)

.Value = "взвод"

.Font.Name = "MS Serif"

.Font.Size = 8

End With

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours + 1).Address

End If

' Расстановка часов по дням

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHours).Address

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address

For iHourCounter = 1 To iHours 'цикл по часам в дне dDay

MyWindow.ActiveSheet.Cells(iCurRow + 1, iCurCol + iHourCounter).Value = iHourCounter

MyWindow.ActiveSheet.Cells(iCurRow + 17, iCurCol + iHourCounter).Value = iHourCounter

Next

If dDay < 7 Then

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, WeekdayName(dDay) & " - " & FormatDateTime(dStartWeekDay + dDay - 1, vbLongDate)

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address, WeekdayName(dDay) & " - " & FormatDateTime(dStartWeekDay + dDay - 1, vbLongDate)

Else

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow, iCurCol + iHours).Address, WeekdayName(dDay)

MergeCellsText MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + 18, iCurCol + iHours).Address, WeekdayName(dDay)

End If

' Расстановка взводов

For i = 4 To 6 'Роты

MakeFrameBorder MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 - 13, iCurCol + 1).Address, MyWindow.ActiveSheet.Cells(iCurRow + i * 5 - 14, iCurCol + iHours).Address

With MyWindow.ActiveSheet.Range(MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 - 13, iCurCol + 1).Address & ":" & MyWindow.ActiveSheet.Cells(iCurRow + i * 5 - 14, iCurCol + iHours).Address)

.Font.Name = "MS Serif"

.Font.Size = 6

End With

For j = 1 To 5 'Взвода

iPlatoon = 200 + 10 * i + j

If dDay = 1 Or dDay = 4 Then

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j - 14, iCurCol).Value = iPlatoon

End If

If dDay = 3 Or dDay = 7 Then

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j - 14, iCurCol + iHours + 1).Value = iPlatoon

End If

' Rem Поиск занятия в расписании

sqlQuery = "SELECT Предметы.Цвет, Предметы.Кратк_название & ' ' & План.Тема & '/' & IIF(АвтовставкаТем.Тема is not null,АвтовставкаТем.Тема,План.Занятие)& ' ' & План.Место_проведения AS Имя, План.Длина, Расписание.Время "

sqlQuery = sqlQuery & "FROM (((Расписание INNER JOIN План ON Расписание.Код_занятия=План.Код_занятия)"

sqlQuery = sqlQuery & "INNER JOIN Предметы ON План.Код_предмета=Предметы.Код_предмета)"

sqlQuery = sqlQuery & "LEFT JOIN [АвтовставкаТем] ON (Расписание.Дата=АвтовставкаТем.Дата AND Расписание.Код_занятия=АвтовставкаТем.Код_занятия))"

sqlQuery = sqlQuery & "WHERE Расписание.Дата=CDate('" & FormatDateTime(dStartWeekDay + dDay - 1, vbShortDate) & "') "

sqlQuery = sqlQuery & "AND Расписание.Взвод=" & Str(iPlatoon)

Set rstLessons = dbsDatabase.OpenRecordset(sqlQuery)

Do Until rstLessons.EOF

Rem занятие найдено, устанавливаем длину и название ячейки

Set fldName = rstLessons.Fields("Имя")

Set fldLong = rstLessons.Fields("Длина")

Set fldTime = rstLessons.Fields("Время")

Set fldColor = rstLessons.Fields("Цвет")

With MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j - 14, iCurCol + fldTime.Value)

MergeCellsText .Address, .Offset(0, fldLong.Value - 1).Address, fldName.Value

If Not IsNull(fldColor) Then

If fldColor.Value > 0 Then MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j - 14, iCurCol + fldTime.Value).Interior.Color = fldColor.Value

End If

MyWindow.ActiveSheet.Cells(iCurRow + (i - 1) * 5 + j - 14, iCurCol + fldTime.Value).WrapText = True

End With

rstLessons.MoveNext

Loop

rstLessons.Close

Next j

Next i

iCurCol = iCurCol + iHours

Next dDay

End Sub

Sub MakeFrameBorder(strStartCell, strEndCell, Optional wInsideVertical = xlThin)

'Изменение рамки вокруг блока (внутри тонкие, снаружи толстые)

Set MyRange = MyWindow.ActiveSheet.Range(strStartCell & ":" & strEndCell)

MyRange.Borders(xlDiagonalDown).LineStyle = xlNone

MyRange.Borders(xlDiagonalUp).LineStyle = xlNone

With MyRange.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With MyRange.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlMedium 'xlThin

.ColorIndex = xlAutomatic

End With

With MyRange.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With MyRange.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlMedium

.ColorIndex = xlAutomatic

End With

With MyRange.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = wInsideVertical

.ColorIndex = xlAutomatic

End With

With MyRange.Borders(xlInsideHorizontal)

' .LineStyle = xlContinuous

.Weight = xlThin

' .ColorIndex = xlAutomatic

End With

End Sub

Sub MergeCellsText(strStartCell, strEndCell, strText)

Rem Объединение ячеек и надпись строки по центру

With MyWindow.ActiveSheet.Range(strStartCell & ":" & strEndCell)

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlVAlignTop

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = True

.Formula = strText

End With

End Sub

Sub SetPageProperties(Optional Orient = xlLandscape)

'

' Настройки параметров страницы

'

With MyWindow.ActiveSheet.PageSetup

' .PrintTitleRows = ""

' .PrintTitleColumns = ""

' .PrintArea = ""

.Orientation = Orient

.LeftMargin = Application.InchesToPoints(0.4)

.RightMargin = Application.InchesToPoints(0.4)

.TopMargin = Application.InchesToPoints(0.4)

.BottomMargin = Application.InchesToPoints(0.4)

' .HeaderMargin = Application.InchesToPoints(0.5)

' .FooterMargin = Application.InchesToPoints(0.5)

' .PrintGridlines = False

' .PrintComments = xlPrintNoComments

' .PrintQuality = 600

.CenterHorizontally = True

.CenterVertically = True

' .Draft = False

.PaperSize = xlPaperA4

' .FirstPageNumber = xlAutomatic

' .Order = xlDownThenOver

' .BlackAndWhite = False

' .Zoom = 100

' .PrintErrors = xlPrintErrorsDisplayed

End With

End Sub

Sub SetPageProperties1(Optional Orient = xlLandscape)

'

' Настройки параметров страницы

'

With MyWindow.ActiveSheet.PageSetup

' .PrintTitleRows = ""

' .PrintTitleColumns = ""

' .PrintArea = ""

.Orientation = Orient

.LeftMargin = Application.InchesToPoints(0.4)

.RightMargin = Application.InchesToPoints(0.4)

.TopMargin = Application.InchesToPoints(0.4)

.BottomMargin = Application.InchesToPoints(0.4)

' .HeaderMargin = Application.InchesToPoints(0.5)

' .FooterMargin = Application.InchesToPoints(0.5)

' .PrintGridlines = False

' .PrintComments = xlPrintNoComments

' .PrintQuality = 600

.CenterHorizontally = True

.CenterVertically = False

' .Draft = False

.PaperSize = xlPaperA4

' .FirstPageNumber = xlAutomatic

' .Order = xlDownThenOver

' .BlackAndWhite = False

' .Zoom = 100

' .PrintErrors = xlPrintErrorsDisplayed

End With

End Sub

Sub SetPageProperties2(Optional Orient = xlLandscape)

'

' Настройки параметров страницы

'

With MyWindow.ActiveSheet.PageSetup

' .PrintTitleRows = ""

' .PrintTitleColumns = ""

' .PrintArea = ""

.Orientation = Orient

.LeftMargin = Application.InchesToPoints(0.4)

.RightMargin = Application.InchesToPoints(0.4)

.TopMargin = Application.InchesToPoints(0.4)

.BottomMargin = Application.InchesToPoints(0.4)

' .HeaderMargin = Application.InchesToPoints(0.5)

' .FooterMargin = Application.InchesToPoints(0.5)

' .PrintGridlines = False

' .PrintComments = xlPrintNoComments

' .PrintQuality = 600

.CenterHorizontally = True

.CenterVertically = False

' .Draft = False

.PaperSize = xlPaperA4

' .FirstPageNumber = xlAutomatic

' .Order = xlDownThenOver

' .BlackAndWhite = False

.Zoom = 80

' .PrintErrors = xlPrintErrorsDisplayed

End With

End Sub

Размещено на Allbest.ru