С записями таблицы базы данных

На рисунке практически все элементы помечены своим именем, за исключением полосы прокрутки - ScrollBar1, и кнопок добавить и удалить - CommandButton1, CommandButton2. Объекты TextBox помечены сокращенным именем. В объект LabelRecord выводится номер текущей записи и количество записей. После создания формы необходимо ввести в ее модуль следующий программный код:

Option Explicit

Const ПутькБазе = "c:\Мои документы\R.mdb"

Const ИмяТаблицы = "Таблица1"

'Объявляем переменную для ссылки на базу данных

Dim db As Database

'Объявляем переменную для ссылки на таблицу базы данных

Dim r As Recordset

Dim flag As Boolean

'процедура добавления данных в указатель

Sub ДобавитьДанные(ByVal Данные As Variant, _

ByVal ИндексПоля As Long)

Dim s As String

'запрет обновления данных в указателях

If flag = True Then

Exit Sub

End If

'Разрешаем редактировать поле записи

r.Edit

'Определяем логический тип

If UCase(TypeName(r.Fields(ИндексПоля).Value)) = "BOOLEAN" Then

Данные = CBool(Данные)

'Определяем тип Data

ElseIf UCase(TypeName(r.Fields(ИндексПоля).Value)) = "DATE" Then

On Error Resume Next

Данные = CDate(Данные)

'определяем не строковый тип

ElseIf UCase(TypeName(r.Fields(ИндексПоля).Value)) <> "STRING" Then

'заменяем "," на "."

While InStr(Данные, ",") <> 0

Mid(Данные, InStr(Данные, ","), 1) = "."

Wend

'преобразуем данные в числовой формат

Данные = Val(Данные)

End If

If Данные <> "" Then

'Отключаем ошибку переполнения данных

On Error Resume Next

r.Fields(ИндексПоля).Value = Данные

Else

'присваиваем пусто значение полю

r.Fields(ИндексПоля).Value = Nothing

End If

'Сохраняем изменения в поле записи

r.Update

End Sub

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

Sub ОбновитьПолеВвода(ByVal ИмяПоля As Variant, _

ByVal ИндексПоля As Long)

'Обнуляем поле

ИмяПоля.Value = ""

On Error Resume Next

If UCase(TypeName(r.Fields(ИндексПоля).Value)) = "DATE" Then

'присваиваем отформатированное значение полю дата

ИмяПоля.Value = Format(r.Fields(ИндексПоля).Value, "dd.mm.yyyy")

Else

ИмяПоля.Value = r.Fields(ИндексПоля).Value

End If

End Sub

'Кнопка добавить

Private Sub CommandButton1_Click()

r.AddNew

r.Update

ScrollBar1.Max = r.RecordCount - 1

ScrollBar1.Value = r.RecordCount - 1

ScrollBar1.LargeChange = ScrollBar1.Max

End Sub

'Кнопка удалить

Private Sub CommandButton2_Click()

If ScrollBar1.Max > 0 Then

r.Delete

If ScrollBar1.Value > r.RecordCount - 1 Then

ScrollBar1.Value = r.RecordCount - 1

End If

ScrollBar1.Max = r.RecordCount - 1

ScrollBar1.LargeChange = ScrollBar1.Max

Else

MsgBox "Нельзя удалить единственную запись в таблице!", vbCritical

Exit Sub

End If

ScrollBar1_Change

End Sub

'Полоса прокрутки, для перемещения по записям таблицы

Private Sub ScrollBar1_Change()

'Ввывод номера текущей записи и их количества

LabelRecord.Caption = "Запись № " & ScrollBar1.Value + 1 & _

" Из " & ScrollBar1.Max + 1

'перемещаемся на запись по положению ползунка полосы прокрутки

r.MoveFirst

r.Move ScrollBar1.Value

'запрещаем обновление данных в указателях

flag = True

'Обновляем поля ввода из текущей записи

ОбновитьПолеВвода TextBox1, 0

ОбновитьПолеВвода TextBox2, 1

ОбновитьПолеВвода CheckBox1, 2

'разрешаем обновление данных в указателях

flag = False

End Sub

'Строковое поле, поле Memo или числовое поле или Data

Private Sub TextBox1_Change()

ДобавитьДанные TextBox1.Text, 0

End Sub

'Строковое поле, поле Memo или числовое поле или Data

Private Sub TextBox2_Change()

ДобавитьДанные TextBox2.Text, 1

End Sub

'Логическое поле

Private Sub CheckBox1_Click()

ДобавитьДанные CheckBox1.Value, 2

End Sub

Private Sub UserForm_Initialize()

'При загрузке формы устанавливаем указатели на базу

Set db = Workspaces(0).OpenDatabase(ПутькБазе)

Set r = db.OpenRecordset(ИмяТаблицы)

'Имя таблицы в заголовок формы

Me.Caption = ИмяТаблицы

If r.RecordCount = 0 Then

'если таблица не имеет записей, добавляем пустую запись

CommandButton1_Click

End If

'Загрузка имен полей

Label1.Caption = r.Fields(0).Name

Label2.Caption = r.Fields(1).Name

'Имя логическое поля

CheckBox1.Caption = r.Fields(2).Name

'Установка границ полосы прокрутки

ScrollBar1.Min = 0

ScrollBar1.Max = r.RecordCount - 1

ScrollBar1.Value = 0

ScrollBar1.LargeChange = ScrollBar1.Max

ScrollBar1_Change

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

'При нажатии на кнопку закрыть [х], выгружаем форму

Unload Me

End Sub

Private Sub UserForm_Terminate()

'При закрытии формы, закрываем указатели

r.Close

db.Close

End Sub