15.5. Пример программы расчета

Требуется создать процедуру расчета и вывода на экран значения среднего возраста всех студентов таблицы Студенты учебной базы данных.

'Работа с записями таблицы - просмотр и расчет среднего возраста

Sub Расчет()

Dim База, Запись As Variant

Dim СрВозраст As Single, СумВозраст As Integer, _

ЧислоЗаписей As Long

Set База = CurrentDb 'семейство объектов текущей базы данных

Set Запись База.OpenRecordSet("Студенты")

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

СумВозраст = 0

ЧислоЗаписей = 0

Do Until Запись.EOF = True

ЧислоЗаписей = ЧислоЗаписей + 1

СумВозраст = СумВозраст + (Year(Date) - _

Year(Запись![ДатаРождения].Value))

Запись.MoveNext 'метод перехода к следующей записи

Loop

СрВозраст = СумВозраст / ЧислоЗаписей

'или СрВозраст = СумВозраст /Запись.RecordCount

'сойство RecordCount возвращает число записей

MsgBox "Средний возраст равен " & Format(СрВозраст, "Standard")

End Sub

15.6. Пример программы ввода новой записи

Требуется создать процедуру ввода новой записи в таблицу Студенты учебной базы данных.

'Работа с записями таблицы - добавление

'Программа не проверяет корректность вводимых значений,

'не отслеживает нажатие кнопки Cancel,

'не осуществляет поиск дублирующих записей в поле КодСтудента 'таблицы "Студенты"

Sub добавление1()

Dim База, Запись As Variant

Set База = CurrentDb

Set Запись = База.OpenRecordSet("Студенты")

With Запись

.AddNew 'метод добавляет запись

![КодСтудента].Value = InputBox("Введите код", "Ввод", _

"141111")

![Фамилия].Value = InputBox("Введите фамилию студента", _

"Ввод", "Шариков")

![Имя].Value = InputBox("Введите имя", "Ввод", "Полиграф")

![Отчество].Value = InputBox("Введите отчество студента", _

"Ввод", "Полиграфович")

![ДатаРождения].Value = CDate(InputBox("Введите дату _

рождения", "Ввод", "01.02.01"))

![Адрес].Value = InputBox("Введите домашний адрес", "Ввод", _

"Москва, Петровка - 25")

![КодСпециальности].Value = InputBox("Введите код _

специальности", "Ввод", "У")

![Курс].Value = CInt(InputBox("Введите курс", "Ввод", "1"))

![Группа].Value = CInt(InputBox("Введите группу", "Ввод", "1"))

![Подгруппа].Value = CInt(InputBox("Введите подгруппу", _

"Ввод", "1"))

.Update 'метод сохраняет новую запись

.Close

End With

End Sub

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

Option Compare Database

'тип данных Type Студент описывается в декларативной части 'модуля

Private Type Студент

Код As String * 5

Фам As String * 20

Имя As String * 10

Отч As String * 20

Д_Р As Date

Адр As String * 255

КодСпец As String * 1

Курс As Byte

Группа As Byte

Подгруппа As Byte

End Type

Sub добавление2()

Dim Экономист As Студент

Dim q, База, Запись As Variant

Set База = CurrentDb

Set Запись = База.OpenRecordSet("Студенты")

With Экономист

q = InputBox("Введите код", "Ввод", "02111")

'здесь может присутствовать проверка корректности 'введенного значения кода студента

If RTrim(q) = Empty Then Exit Sub Else .Код = q

q = InputBox("Введите фамилию студента", "Ввод", "Шариков")

'здесь может присутствовать проверка корректности 'введенного значения фамилии,

' и т.д.

If RTrim(q) = Empty Then Exit Sub Else .Фам = q

q = InputBox("Введите имя", "Ввод", "Полиграф")

If RTrim(q) = Empty Then Exit Sub Else .Имя = q

q = InputBox("Введите отчество студента", "Ввод", _

"Полиграфович")

If RTrim(q) = Empty Then Exit Sub Else .Отч = q

q = CDate(InputBox("Введите дату рождения", "Ввод", _

"01.02.01"))

If RTrim(q) = Empty Then Exit Sub Else .Д_Р = q

q = InputBox("Введите домашний адрес", "Ввод", "Москва, _

Петровка - 25")

If RTrim(q) = Empty Then Exit Sub Else .Адр = q

q = InputBox("Введите код специальности", "Ввод", "У")

If RTrim(q) = Empty Then Exit Sub Else .КодСпец = q

q = CInt(InputBox("Введите курс", "Ввод", "1"))

If RTrim(q) = Empty Then Exit Sub Else .Курс = q

q = CInt(InputBox("Введите группу", "Ввод", "1"))

If RTrim(q) = Empty Then Exit Sub Else .Группа = q

q = CInt(InputBox("Введите подгруппу", "Ввод", "1"))

If RTrim(q) = Empty Then Exit Sub Else .Подгруппа = q

End With

'Здесь может присутствовать проверка наличия дублирующих 'записей в поле ‘КодСтудента,

'для чего необходимо организовать поиск значения КодСтудента _

'в таблице Студенты,

'аналогичного значению, введенному с клавиатуры

With Запись

.AddNew

![КодСтудента].Value = Экономист.Код

![Фамилия].Value = Экономист.Фам

![Имя].Value = Экономист.Имя

![Отчество].Value = Экономист.Отч

![ДатаРождения].Value = Экономист.Д_Р

![Адрес].Value = Экономист.Адр

![КодСпециальности].Value = Экономист.КодСпец

![Курс].Value = Экономист.Курс

![Группа].Value = Экономист.Группа

![Подгруппа].Value = Экономист.Подгруппа

.Update

.Close

End With

End Sub