Программа для перевода учеников в следующий класс. Программа на языке VBA для ежегодного автоматического перевода учеников в следующий класс

ПРИЛОЖЕНИЕ 1

Программа для перевода учеников в следующий класс

Ниже приведена программа на языке VBA для ежегодного автоматического перевода учеников в следующий класс.

Private Sub Кнопка30_Click()

Dim CurRec As DAO.Recordset, Rec As DAO.Recordset

Dim GraduateRec As DAO.Recordset

Dim CheckDate As DAO.Recordset

Dim CurDate As Date, LDate As Date

Dim count As Integer

Dim SQLsearch As String

Set dbs = CurrentDb

Set CurRec = dbs.OpenRecordset("Ученики", dbOpenDynaset)

Set Rec = dbs.OpenRecordset("Ученики", dbOpenDynaset)

Set GraduateRec = dbs.OpenRecordset("Таблица выпускники", dbOpenDynaset)

Set CheckDate = dbs.OpenRecordset("Статистика работы", dbOpenDynaset)

'1 - проверить соответствие дат

'2 - отыскать всех одиннадцатиклассников и перевести их в выпускники

'3 - остальным прибавить 1 класс

'4 - конец

CheckDate.MoveFirst

LDate = "01.09." & (year(CheckDate.Fields("Ученики").Value) + 1)

CurDate = Date

If (CurDate >= LDate) Then

SQLsearch = "[Код_класс] mod 11 = 0"

CurRec.FindFirst (SQLsearch)

Do While CurRec.NoMatch = False

With GraduateRec

.AddNew

.Fields("Год выпуска").Value = year(Date)

.Fields("Фамилия").Value = CurRec.Fields("Фамилия").Value

.Fields("Имя").Value = CurRec.Fields("Имя").Value

.Fields("Отчество").Value = CurRec.Fields("Отчество").Value

.Fields("Код_класса").Value = CurRec.Fields("Код_класс").Value

.Update

CurRec.Delete

End With

CurRec.FindFirst (SQLsearch)

Loop

CurRec.MoveLast

count = CurRec.RecordCount

CurRec.MoveFirst

Dim i As Integer

For i = 1 To count

With CurRec

.Edit

.Fields("Код_класс").Value = .Fields("Код_класс").Value + 1

.Update

End With

CurRec.MoveNext

Next i

CheckDate.Edit

CheckDate.Fields("Ученики").Value = CurDate

CheckDate.Update

CheckDate.Close

Else

MsgBox "Обновление базе не требуется"

End If

GraduateRec.Close

CurRec.Close

Rec.Close

Set dbs = Nothing

End Sub

ПРИЛОЖЕНИЕ 2

Программа для удаления учеников

Ниже приведена программа для удаления учеников с выводом формы для выбывших учеников и распечаткой приказа.

Private Sub Кнопка119_Click()

Dim CurRec As DAO.Recordset

Dim Surname As String, Name As String, sec_name As String, BornDate As String, kriteria As String

Dim rec2 As DAO.Recordset

Dim dbs As DAO.Database

Dim CurDate As Variant

CurDate = Date

Set dbs = CurrentDb

Set CurRec = dbs.OpenRecordset("Ученики", dbOpenDynaset)

Set rec2 = dbs.OpenRecordset("Выбывшие ученики", dbOpenDynaset)

Me.Фамилия.SetFocus

Surname = Trim(Фамилия.Text)

If (Surname <> "") And (Surname <> "#Удалено") Then

Me.Имя.SetFocus

Name = Trim(Имя.Text)

Me.Отчество.SetFocus

sec_name = Trim(Отчество.Text)

Me.[Дата рождения].SetFocus

BornDate = DateSQL(Trim([Дата рождения].Text))

kriteria = "[Фамилия]='" & Surname & "' and [Имя]='" & Name & "'" & " and [Отчество]='" & sec_name & "'" & " and [Дата рождения]=" & BornDate

CurRec.FindFirst kriteria

With rec2

.AddNew

.Fields("Фамилия").Value = Surname

.Fields("Имя").Value = Name

.Fields("Отчество").Value = sec_name

.Fields("Из какого класса").Value = CurRec.Fields("Код_класс").Value

.Fields("Дата выбытия").Value = CurDate

.Update

End With

With CurRec

.Delete

.MoveNext

End With

Else: MsgBox "Нельзя удалить запись, которой не существует!"

End If

Set dbs = Nothing

DoCmd.OpenForm "Выбывшие ученики", acNormal

End Sub

ПРИЛОЖЕНИЕ 3

Списки аттестуемых учителей

Ниже приведена программа для формирования списка аттестуемых учителей в указанному году (см. рис. 5.2.9).

Private Sub Кнопка11_Click()

Dim dbs As Database, qdf As QueryDef, strSQL As String, year_at As Integer

' имя организации

Dim strOrd As String

' Возвращает ссылку на текущую базу данных.

Set dbs = CurrentDb

' установить фокус

Me.Поле9.SetFocus

' получает строку из поля со списком

year_at = Me.Поле9.Value

year_at = year_at - 5

strOrd = year_at

' построить запрос

strSQL = "SELECT Учителя.Фамилия, Учителя.Имя, Учителя.Отчество, Year(Учителя.[Дата последней аттестации])+5 FROM Учителя WHERE Year(Учителя.[Дата последней аттестации]) =" + strOrd

strSQL = strSQL + " ORDER BY Учителя.Фамилия, Учителя.Имя, Учителя.Отчество;"

'Создает новый запрос.

dbs.QueryDefs.Delete ("Запрос по аттестации")

Set qdf = dbs.CreateQueryDef("Запрос по аттестации", strSQL)

DoCmd.OpenReport "Отчёт по аттестации", acViewPreview

Set dbs = Nothing

End Sub

Результат этой процедуры приведён на рис. П. 3.1

Рис. П. 3.1

ПРИЛОЖЕНИЕ 4

Программа для вывода расписания

Ниже представлена программа для формирования отчёта по расписанию для указанного класса на неделю (см. рис.5.2.7).

Private Sub Кнопка2_Click()

Dim dbs As Database, qdf As QueryDef, strSQL As String

Dim class As String

Set dbs = CurrentDb

Me.ПолеСоСписком0.SetFocus

class = Me.ПолеСоСписком0.Value

strSQL = "SELECT Расписание.КодДняНедели, Расписание.НомерУрока,[Таблица класс].Класс, ДниНедели.День,Уроки.Время, Расписание.НомерКабинета, [Список предметов].Предмет FROM Уроки,[Список предметов],ДниНедели,[Таблица класс] INNER JOIN Расписание ON [Таблица класс].Код_класса = Расписание.КодКласса WHERE ((([Таблица класс].Код_класса) = " + class + " And Уроки.Код=Расписание.НомерУрока And [Список предметов].[Код_списка предметов]=Расписание.КодПредмета And Расписание.КодДняНедели=ДниНедели.Код))ORDER BY Расписание.КодДняНедели, Расписание.НомерУрока;"

dbs.QueryDefs.Delete ("Запрос расписание")

Set qdf = dbs.CreateQueryDef("Запрос расписание", strSQL)

DoCmd.OpenReport "Вывод расписания", acViewPreview

Set dbs = Nothing

End Sub