Использование модулей Access Basic для автоматизации приложений Microsoft Access

 Dim strNewLine   As String

 Dim intMsgRtn As Integer, varReturnVal As Variant

 Dim dbMyBase As Database, tblArchive As TableDef

 Dim fldMyField As Field

 Dim rcdArchive As Recordset, rcdWays As Recordset

If DCount("Номер_С", "[Задолженность]",

                                                      "[Номер_С]" = Me![Номер_С]) = 0 Then

'используем функцию MsgBox для того, чтобы узнать,  действительно ли ‘хотят удалить информацию. Второй аргумент - 33 - указывает  на то,  что ‘окно сообщения будет содержать 2 кнопки OK  и  Cancel  и ‘предупреждающий значок.  При нажатии OK функция возвращает -  1, 'Cancel - приводит к отмене события, вызвавшего процедуру.

'Для более полной информации воспользуйтесь справкой

 If MsgBox("Вы действительно хотите удалить информацию ?",

33, "Удаление информации") <> 1 Then

                                        Cancel = True

                        Exit Sub End If

 End If

'если оценки есть

 strNewLine = Chr(13) & Chr$(10)

'проверяем, нужно ли сохранять записи о оценках в архиве

 intMsgRtn = MsgBox ("Существуют оценки для студента "

                                                                          & Me![Номер_С] & strNewLine

& "Вы хотите сохранить их в архиве ?", 33, "Удаление информации об оценках")

 'переменная dbMyBase ссылается на текущую базу данных

 Set dbMyBase = DBEngine.Workspaces(0).Databases(0)

 'а rcdWays - на набор записей таблицы  "Результаты"

 Set rcdWays = dbMyBase.OpenRecordset("Результаты")

 If intMsgRtn = 1 Then   'если выбрано сохранение в архиве 'переход к следующей инструкции в случае возникновения ошибки

 On Error Resume Next

 'rcdArchive - указатель на набор записей таблицы "Архив",

 'если она существует

 Set rcdArchive = dbMyBase.OpenRecordset("Архив")

                                'проверка ошибки

 Select Case Err

                                    Case 0

'ошибки нет - таблица должна существовать

On Error GoTo 0   'отключение перехвата ошибки 'проверяем, есть ли необходимость очистить архив или просто дописать записи  в конец

intMsgRtn = MsgBox("Архив уже существует." & strNewLine

                              & "Хотите ли Вы его очистить ?", 52) If intMsgRtn = 6 Then                                  ' если ответ был - Да

DoCmd SetWarnings False  'отключаем предупреждение 'Запуск макрокоманды для удаления строк

                                        DoCmd RunSQL "Delete * From Архив;"

                                        DoCmd SetWarnings True   'включаем предупреждения

                                      End If

                                    Case 3011     'таблица не найдена

                                      On Error GoTo 0  'отключаем режим перехвата ошибок

                                      'создаем таблицу

                                      Set tblArchive = dbMyBase.CreateTableDef("Архив")

                                      'создаем поле

Set fldMyField = tblArchive.CreateField("Отправка", DB_TEXT)

                                      fldMyField.Size = 20

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                                      'создаем поле

Set fldMyField = tblArchive.CreateField("Дата_отпр", DB_DATE)

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                                      'создаем поле

Set fldMyField = tblArchive.CreateField("Фамилия", DB_TEXT, 20) 'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                                      'создаем поле

Set fldMyField = tblArchive.CreateField("Дата_приб", DB_DATE)

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                        'создаем поле

Set fldMyField = tblArchive.CreateField("Средний балл", DB_INTEGER)

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                        'создаем поле

Set fldMyField = tblArchive.CreateField("Оцека_П", DB_BYTE) 'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                        'создаем поле

Set fldMyField = tblArchive.CreateField("Вес", DB_BYTE) 'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                        'создаем поле

Set fldMyField = tblArchive.CreateField("Оценка_Л", DB_BYTE)

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

                        'создаем поле

Set fldMyField = tblArchive.CreateField("Оценка_Т", DB_TEXT, 10)

'присоединяем поле к семейству полей новой таблицы tblArchive.Fields.Append fldMyField

'добавление новой таблицы к семействуTableDefs текущей БД dbMyBase.TableDefs.Append tblArchive

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

                        Set rcdArchive = dbMyBase.OpenRecordset("Архив")

              Case Else    'если не удается идентифицировать ошибку

                        'выдаем сообщение и завершаем работу процедуры

                        MsgBox ("=хшчтхёЄэр  ю°шсър" & Err & Error$(Err))

                        Exit Sub

End Select

'инициализация индикатора выполнения программы в строке состояния varReturnVal = SysCmd(SYSCMD_SETSTATUS, "Работа с архивом")

DoCmd Hourglass True 'включение песочных часов

rcdWays.MoveFirst   'перемещение на первую запись набора номера студента

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

'для  нахождения нужной

While Not rcdWays.EOF

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

    If Me![Номе6р_С] = rcdWays("Номер_С") Then

                                  'переписываем данные в архив

                                  rcdArchive.AddNew

rcdArchive("Фамилия") = rcdWays("Средний балл") rcdArchive("Оцека_П") = rcdWays("Оценка_П") rcdArchive("Оценка_Л") = rcdWays("Оценка_Л") rcdArchive("Оценка_Т") = rcdWays("Оценка_Т") rcdArchive("Домашний адрес") = rcdWays("Домашний адрес")

rcdArchive.Update

'сохраняем сделанные изменения в архиве rcdWays.Delete  'удаляем соответствущую запись из "Задолженность"

    End If

rcdWays.MoveNext  'перемещаемся на следующую запись

Wend

rcdArchive.Close  'закрываем набор записей архива

MsgBox ("Удаление с записью в архив произведено

'если нужно просто удалить записи данные, это 'выполнит Access

rcdWays.Close   'заркываем набор записей студентов End If

DoCmd Hourglass False 'выключение песочных часов 'переустановим строку статуса

varReturnVal = SysCmd(SYSCMD_SETSTATUS, " ")

 Cancel = False

End Sub

        Работу по удалению остальных данных выполнит Access.   Чтобы при работе снова не было диалога на предмет отмены удаления,  так как проверка уже произведена нами,  то для этого в бланке свойств формы "Задолженность" аналогичным образом создадим процедуру для свойства Before Del Confirm. Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer) 'Access может продолжать работу по удалению без выдачи сообщения Response = DATA_ERRCONTINUE

End Sub

3.2  Добавим еще одну процедуру обработки событий этой формы, ко­торая выполняется в ответ на событие On Current (  От записи к за­писи).  Оно происходит каждый раз,  когда Вы перемещаетесь к дру­гой строке, включая перемещение на новую запись.  Так как при переходе на новую запись через кнопки навигации не  устанавливается соответствующее значение в поле с выпадающим списком  и  открытая форма "Средний балл" не изменяет текущую запись  на  соответствую­щую текущей записи "Задолженность", то определим следующий текст процедуры:

Sub Form_Current ()

 'при переходе на новую запись поле "Номер Студента"

'должно содержать то же значение, что и "Номер_С"

 Me![Номер студента] = Me![Номер_С]

 'если перешли на новую строку,

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

 If IsNull(Me![Ном_знак]) Then intNewRow = True

                                                                                              Else intNewRow = False

 'если загружена форма "Средний балл",

 'то загружаем ее с нужными данными

 If Not IsLoaded("средний балл") Then Exit Sub

                        DoCmd RunMacro "Задолженность.Средний балл"

End Sub

3.3 Так как существует вероятность того,  что студент   ка­кое-то время может не учиться (взять академку, повторку, декретный отпуск),  то для корректного хранения информации необходимо написать  обра­ботку события On Delete для формы "Средний балл":

Sub Form_Delete (Cancel As Integer)

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