' Переменные уровня модуля

Private ws As workspace

Private db As Database

Private rs As Recordset

Private rsClone As Recordset

Private Фамилия As String

Private Критерий As String

Private Закладка As Variant

Private Sub UserForm_Initialize()

'Создание рабочей области

Set ws = DBEngine.Workspaces(0)

'Открытие базы данных студенты.mdb

Set db = ws.OpenDatabase(Name:=ThisWorkbook.Path & "\Example.MDB")

'Создание записей

Set rs = db.OpenRecordset("Первый курс", dbOpenDynaset)

'Принудительное перемещение на последнюю rs для того, чтобы определить число записей

rs.MoveLast

'Вывод числа записей в надпись Всего записей

lblNumberOfRec.Caption = "Всего записей " & CStr(rs.RecordCount)

'Принудительное перемещение на первую rs

rs.MoveFirst

'вывод первой записи в поля диалогового окна

Showrecord

'создание копии записи и выбор переключателя

Set rsClone = rs.Clone

OptAll.Value = True

End Sub

Private Sub cmdSearch_Click()

'Найти запись с указанной фамилией

Закладка = rs.Bookmark

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

Критерий = "[Фамилия]='" & Фамилия & "'"

rs.FindFirst Критерий

If rs.NoMatch = False Then

Showrecord

Else

MsgBox "Запись не найдена", vbInformation, "Студенты"

rs.Bookmark = Закладка

Showrecord

End If

End Sub

Private Sub cmdSearchNext_Ciick()

'Найти следующую запись с той же фамилией

Закладка = rs.Bookmark

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

Критерий = "[Фамилия]='" & Фамилия & "'"

rs.FindNext Критерий

If rs.NoMatch = False Then

Showrecord

Else

MsgBox "Больше таких записей нет", vbInformation, "Студенты"

rs.Bookmark = Закладка

Showrecord

End If

End Sub

Private Sub cmdDelete_Click()

' Удаление записи

With rs

.Delete

.MoveNext

End With

Showrecord

lblNumberOfRec.Caption = "Всего записей " & CStr(rs.RecordCount)

End Sub

Private Sub cmdAddNew_Click()

' Добавить новую запись

With rs

.AddNew

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

.Fields("Специальность").Value = txtGroup.Text

.Fields("Предмет").Value = txtSubject.Text

.Fields("Оценка").Value = txtMark.Text

.Update

End With

lblNumberOfRec.Caption = "Всего записей " & CStr(rs.RecordCount)

End Sub

Private Sub cmdEdit_Click()

' Редактирование записи

With rs

.Edit

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

.Fields("Специальность").Value = txtGroup.Text

.Fields("Предмет").Value = txtSubject.Text

.Fields("Оценка").Value = txtMark.Text

.Update

End With

End Sub

Private Sub cmdClose_Click()

' Закрытие записи, база данных и окна

closedb

End Sub

Private Sub cmdMoveFirst_Click()

' Переход к первой записи

rs.MoveFirst

Showrecord

End Sub

Private Sub cmdMovePrevious_Click()

'Переход к предыдущей записи

rs.moveprevious

If rs.BOF = True Then

rs.MoveFirst

MsgBox "Первая запись", vbInformation, "Студенты"

End If

Showrecord

End Sub

Private Sub cmdMoveNext_Click()

'Переход к последующей записи

rs.MoveNext

If rs.EOF = True Then

rs.MoveLast

MsgBox "Последняя запись", vbInformation, "Студенты"

End If

Showrecord

End Sub

Private Sub optBest_Click()

'Отображение только хорошистов и отличников

'Создание копии записи

Set rsClone = rs.Clone

'Фильтрация записей по критерию

rs.Filter = "[Оценка]>=4"

'Создание отфильтрованной записи

Set rs = rs.OpenRecordset()

If rs.RecordCount > 0 Then

Showrecord

Else

MsgBox "Таких студентов нет", vbInformation, "Студенты"

Set rs = rsClone.Clone

Set rs = rs.OpenRecordset()

OptAll.Value = True

End If

End Sub

Private Sub OptAll_Click()

'Отображение всех студентов

Set rs = rsClone.OpenRecordset()

Showrecord

End Sub

Private Sub Showrecord()

'Вывод записи в поля диалогового окна

With rs

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

txtGroup.Text = .Fields("Специальность").Value

txtSubject.Text = .Fields("Предмет").Value

txtMark.Text = .Fields("Оценка").Value

End With

End Sub

Private Sub closedb()

'Закрытие записей, базы данных, рабочего пространства и окна

rs.Close

rsClone.Close

db.Close

ws.Close

Unload Me