Информатика и выч. техника \ Разработка и стандартизация программных систем и информационных технологий

Пакет прикладных программ для управления медиатекой. Тексты программ, страница 3

Dim strFilter As String

Dim code As Integer

Set dbs = CurrentDb ' Определение текущей БД

Set rst = dbs.OpenRecordset("Clients", dbOpenTable)

With rst

        .Index = "Kod_k"                                             ‘Присваивание кода клиента

        .Seek "=", Me![Kod_p]                                    ‘Присваивание значения кода клиента

    With rst

        .Delete ‘ Удаление найденной строки и вывод сообщения

        MsgBox "Вся информация о данном клиенте удалена из нашей базы"

        End With

        Requery ‘ Обновление формы

       rst.Close

  End With

  Set rst = dbs.OpenRecordset("UsingUnits", dbOpenTable) ‘ установка переменой окружения таблицы «UsingUnit»

label1:         With rst

        rst.Index = "UsingUnitsKod_k" ‘Присваивание кода клиента

        ‘Присваивание значения кода клиента

        rst.Seek "=", Me![kod_p]

  If rst.NoMatch Then ‘ Если клиент никогда не делал заказов, то выдастся сообщение

      MsgBox "На данный момент у него нет заказов"

   If rst.EOF Then GoTo label2: ‘ еСЛИ все записи в таблицы проверены, и больше их нет, то перейдем на метку 12

 Else

    With rst

        .Delete ‘ Удаление  текущей записи…и переход к следующей

        rst.MoveNext

        End With

        GoTo label1

  End If

  rst.Close

label2:       Me![kod_p] = " " ‘ удаление  значений, для удобства интерфейса

              Me![kod_а] = " "

              Me![kod_т] = " "

 Me.Requery ‘ Обновление

End With

End Sub

  1. Кнопка «Добавление нового экземпляра уже имеющегося носителя»

rivate Sub Кнопка6_Click()

Dim stDocName As String

Dim stLinkCriteria As String

Dim dbs As Database, rst As Recordset

Dim strFilter As String

Dim code As Integer

Set dbs = CurrentDb ' Определение текущей БД

 Set rst = dbs.OpenRecordset("Units", dbOpenTable)

 If IsNull([Kod_u]) Then

    MsgBox "Введите название"

    Else

 With rst

        .Index = "Kod_u" ‘Присваивание кода носителя

        ‘Присваивание значения кода носителя

        .Seek "=", Me![Kod_u]

  If IsNull([CountCommon]) Then ‘ проверка на то, чтобы количество не было равно нулю

  MsgBox "Этого экземпляра в базе и так нет"

  Else

  With rst

        .Edit

        ![CountCommon] = ![CountCommon] + 1 ‘ Увеличение числа общего количества на единицу

        MsgBox "Экземпляр добавлен в базу" ‘ сообщение об успешном добавлении

        .Update

        End With

       rst.Close

   Me.Refresh 'Обновляем форму

  End If

  End With

End Sub

  1. Процедура нажатия кнопки «Удалить носитель», удаляется по одному экземпляру, если значение общего количества становится равным 0, то вся информация об этом носители удаляется из базы данных

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

Dim stDocName As String

Dim stLinkCriteria As String

Dim dbs As Database, rst As Recordset

Dim strFilter As String

Set dbs = CurrentDb ' Определение текущей БД

 Set rst = dbs.OpenRecordset("Units", dbOpenTable)

 With rst

       .Index = "Kod_u"

       .Seek "=", Me![Kod_u]

       If ([CountCommon] = [CountCurrent]) And ([CountCurrent] <> 0) Then ‘ еСЛИ значение выданных носителей равно текущему количеству

       MsgBox "Этот носитель находится на руках, вы не можете его удалить"

       Else

       With rst

        .Edit

        ![CountCommon] = ![CountCommon] – 1 ‘ Уменьшение количества на единицу

        MsgBox "Экземпляр удален из базы"

        .Update

        End With

       rst.Close

       'If IsNull([CountCommon]) And IsNull([CountCurrent]) Then

    Set rst = dbs.OpenRecordset("UsingUnits", dbOpenTable)

label1:         With rst

        rst.Index = "Kod_u" ‘Присваивание кода носителя

        ‘Присваивание значения кода носителя

        rst.Seek "=", Me![Kod_u]

  If rst.NoMatch Then

      MsgBox "На данный носителя на руках нет"

   If rst.EOF Then GoTo label2:  ‘ Если  запись была последняя в таблице UsingUnits идем на метку12

 Else

    With rst

        .Delete ‘ Удаление найденной записи

        rst.MoveNext ‘ Переход к следующей записи

        End With

        Me.Refresh ‘ Обновление значений

        GoTo label1 ‘ Переход  на метку  11

  End If

  rst.Close

label2:

Set rst = dbs.OpenRecordset("Units", dbOpenTable)

If ([CountCommon] = 0) And ([CountCurrent] = 0) Then

label3: With rst

        .Index = "Kod_u" ‘Присваивание кода носителя

        ‘Присваивание значения кода носителя

        .Seek "=", Me![Kod_u]

    With rst

        .Delete ‘ удаление записи из таблицы Units

        End With

        MsgBox "Вся информация о данном носителе удалена из базы"

        Me.Requery

       rst.Close

  End With

 Me.Requery

   Me.Refresh 'Обновляем форму

End If

End If

End With

End If

End With

End Sub

  1. Процедура на нажатие кнопки «Выдача статистики по клиенту»

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

If IsNull([FIO]) Then ‘ Проверка на наличие всех параметров выдачи информации

    MsgBox "Введите фамилию"

    Else

    If IsNull([chislos]) Then

    MsgBox "Введите начальную дату"

    Else

    If IsNull([chislop]) Then

    MsgBox "Введите конечную дату"

Else ‘ ЕСЛИ все верно, то открываем форму «Статистика по клиенту»

    Dim stDocName As String

    Dim stLinkCriteria As String

    stDocName = "Статистика по клиенту"

    DoCmd.OpenForm stDocName, , , stLinkCriteria

End If

End If

End If

End Sub

  1.  Процедура обновления списка в форме «Удаление клиента». После того как мы ввели значение в списке, в поля устанавливается остальная информация о клиенте

Private Sub NameIO_AfterUpdate()

Me!kod_p = Me![NameIO].Column(0) ‘ копирование значений из столбцов списка

Me!kod_а = Me![NameIO].Column(2)

Me!kod_т = Me![NameIO].Column(3)

End Sub

Скачать файл