Разработка информационной системы "Компьютерная фирма"

            vbExclamation + vbDefaultButton2 + vbOKCancel, "Предупреждение") <> vbOK) Then

            GoTo Exit_Sub

        End If

         .SQL = "EXECUTE DeleteEmpl '" & cbxEmplPass & "'"

        .Execute

    End With

    Me.Refresh

    SetStatus "Информация о  сотруднике была удалена"

    ClearFields

    Exit_Sub:

    Exit Sub

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub btnSaveChanges_Click()

On Error GoTo Err_Handler

    Dim qdfEmpl As QueryDef

    Dim rstEmpl As Recordset

    ' Create a temporary QueryDef object

    Set qdfEmpl = CurrentDb.CreateQueryDef("")

    With qdfEmpl

        .Connect = strCurrentODBCConnectStr

        .ReturnsRecords = False

        If (cbxEmplPass.ListIndex = -1) Then

           .SQL = "EXECUTE InsertEmpl '"

        Else

           .SQL = "EXECUTE UpdateEmpl '"

        End If

        .SQL = .SQL & cbxEmplPass & "', '" & cbxFIO & "', '" & cbxPost & "', '" & _

                    Format(dtpBirthDate, "yyyy-mm-dd") & _

                    "', '" & tbxAddress & "', '" & tbxPhoneHome & "', '" & tbxPhoneMobile & "'"

        .Execute

    End With

    Me.Refresh

    SetStatus "Изменения были  успешно произведены"

    ClearFields

Exit_Sub:

    Exit Sub

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub cbxEmplPass_AfterUpdate()

On Error GoTo Err_Handler

     If (IsNull(cbxEmplPass)) Then

        Exit Sub

    End If

        If (cbxEmplPass.ListIndex = -1) Then

        Exit Sub

    End If

        Dim qdfEmpl As QueryDef

    Dim rstEmpl As Recordset

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfEmpl = CurrentDb.CreateQueryDef("")

    With qdfEmpl

       .Connect = strCurrentODBCConnectStr

       .ReturnsRecords = True

       .SQL = "EXECUTE GetEmplByPass '" & cbxEmplPass.Text & "'"

       Set rstEmpl = .OpenRecordset(dbOpenSnapshot)

    End With

        With rstEmpl

        cbxFIO = !ФИО_Сотрудника

        cbxPost = !Должность

        dtpBirthDate = !Дата_рождения

        tbxAddress = !Адрес_сотрудника

        tbxPhoneHome = !Телефон_домашний

        tbxPhoneMobile = !Телефон_мобильный

           .Close

    End With

    SetStatus "Поля успешно  заполнены"

Exit_Sub:

    Exit Sub

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub cbxFIO_AfterUpdate()

On Error GoTo Err_Handler

        If (IsNull(cbxFIO)) Then

        Exit Sub

    End If

        If (cbxFIO.ListIndex = -1) Then

        Exit Sub

    End If

       Dim qdfEmpl As QueryDef

    Dim rstEmpl As Recordset

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfEmpl = CurrentDb.CreateQueryDef("")

    With qdfEmpl

        .Connect = strCurrentODBCConnectStr

        .ReturnsRecords = True

        .SQL = "EXECUTE GetEmplByFIO '" & cbxFIO.Text & "'"

        Set rstEmpl = .OpenRecordset(dbOpenSnapshot)

    End With

        With rstEmpl

        cbxEmplPass = !Номер_паспорта_сотрудника

        cbxPost = !Должность

        dtpBirthDate = !Дата_рождения

        tbxAddress = !Адрес_сотрудника

        tbxPhoneHome = !Телефон_домашний

        tbxPhoneMobile = !Телефон_мобильный

       

        rstEmpl.MoveNext

        If (Not .EOF) Then

            MsgBox "Обнаружено более одного  сотрудника с данным ФИО." & vbCrLf & _

                    "Для конкретного определения  используйте номер паспорта", vbExclamation, "Предупреждение"

        End If

             .Close

    End With

    SetStatus "Поля успешно заполнены"

 

Exit_Sub:

    Exit Sub

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub Form_Open(Cancel As Integer)

On Error GoTo Err_Handler

        InitRowSources

    ClearFields

       

    SetStatus "Инициализация формы завершена"

Exit_Sub:

    Exit Sub

 

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Public Sub ClearFields()

    cbxEmplPass = Null

    cbxFIO = Null

    cbxPost = Null

    tbxPhoneHome = Null

    tbxPhoneMobile = Null

    tbxAddress = Null

        cbxEmplPass.SetFocus

End Sub

 

Public Sub InitRowSources()

    CurrentDb.QueryDefs("qGetAllEmplPass").Connect = strCurrentODBCConnectStr

    cbxEmplPass.RowSourceType = "Table/Query"

    cbxEmplPass.RowSource = "qGetAllEmplPass"

    CurrentDb.QueryDefs("qGetAllEmplFIO").Connect = strCurrentODBCConnectStr

    cbxFIO.RowSourceType = "Table/Query"

    cbxFIO.RowSource = "qGetAllEmplFIO"

    CurrentDb.QueryDefs("qGetAllEmplPost").Connect = strCurrentODBCConnectStr

    cbxPost.RowSourceType = "Table/Query"

    cbxPost.RowSource = "qGetAllEmplPost"

End Sub

Все остальные отделы имеют свои аналогичные формы (рисунки 19, 20, 21, 22), позволяющие выбрать необходимую автоматизируемую функцию.

Рисунок 19 – Форма «Магазин»

Рисунок 20 – Форма «Склад»

Рисунок 21 – Форма «Гарантийный отдел»

Рисунок 22 – Форма «Отдел работы с клиентами»

Для магазина наиболее часто  используемой формой является «Продажа» (рисунок 23). С ее помощью можно внести комплексную продажу в базу, выдать гарантийный талон и кредитный договор, а также зафиксировать серийные номера проданных экземпляров.

Рисунок 23 – Форма «Продажа»

 

Кнопка «Готово» регистрирует продажу, выводит гарантийный талон  и кредитный договор (если есть). Предпросмотр гарантийного талона и кредитного договора можно осуществить с помощью соответствующих кнопок на форме.

Код обработчиков событий  формы:

Private Sub bntShowGarantee_Click()

    DoCmd.OpenReport "Гарантийный  талон", acViewPreview

End Sub

 

Private Sub btnAdd_Click()

On Error GoTo Err_Handler

    Dim strFirstPayment As String

    Dim strMonthPayment As String

    Dim strPaymentTerm As String

    Dim strNewRow As String

     If IsNull(cbxBarCode) Then

        Err.Raise 513, Me.Name, "Введите штрихкод товара"

    End If

       If IsNull(cbxPaymentType) Then

        Err.Raise 513, Me.Name, "Выберите тип оплаты"

    End If

   

    If (cbxPaymentType.ListIndex = 3 And IsNull(cbxReplacementCode)) Then

        Err.Raise 513, Me.Name, "Укажите код направления на  замену товара"

    End If

    If (IsNull(tbxCount)) Then

        Err.Raise 513, Me.Name, "Укажите количество экземпляров"

    End If

    If Not IsPositiveNumber(tbxCount) Then

        Err.Raise 513, Me.Name, "Количество экземпляров должно  быть натуральным числом"

    End If

    strNewRow = cbxBarCode & ";" & cbxName & ";" & cbxPaymentType & ";" & tbxCount & ";" & GetCurPrice()

    If (cbxPaymentType = "В кредит") Then

        If IsNull(cbxClientPass) Then

            Err.Raise 513, Me.Name, "Укажите номер паспорта клиента"

        End If

        If IsNull(tbxFirstPayment) Then

            strFirstPayment = "0"

        Else

            If (Not IsPercent(tbxFirstPayment)) Then

                Err.Raise 513, Me.Name, "Процент первоначального  взноса должен быть числом  от 0 до 100"

            End If

            strFirstPayment = tbxFirstPayment

        End If

        If IsNull(tbxMonthPayment) Then

            strMonthPayment = "0"

        Else

            If (Not IsPercent(tbxMonthPayment)) Then

                Err.Raise 513, Me.Name, "Процент помесячной  выплаты должен быть числом  от 0 до 100"

            End If

            strMonthPayment = tbxMonthPayment

        End If

        If IsNull(tbxPaymentTerm) Then

            strPaymentTerm = "0"

        Else

            If (Not IsNonNegativeNumber(tbxPaymentTerm)) Then

                Err.Raise 513, Me.Name, "Срок оплаты должен быть неотрицательным целым числом"

            End If

            strPaymentTerm = tbxPaymentTerm

        End If

        strNewRow = strNewRow & ";" & strFirstPayment & ";" & strMonthPayment & ";" & strPaymentTerm

    End If

    Dim index As Long

    index = GetSoldGoodsIndex(cbxBarCode)

    With lbxSoldGoods

        If (index = .ListCount) Then

            .AddItem strNewRow

            Dim i As Long

            Dim strSerial As String

            Dim rstSerials As Recordset

            Set rstSerials = CurrentDb.OpenRecordset("Серийные", dbOpenDynaset)

            For i = 0 To CLng(tbxCount) - 1

                strSerial = InputBox("Введит серийный номер экземпляра №" & i, "Ввод серийного номера")

                If (IsNull(strSerial)) Then

                    Exit For

                End If

                With rstSerials

                    .AddNew

                    !Штрихкод_товара = cbxBarCode

                    !Серийный_номер = strSerial

                    .Update

                    .Bookmark = .LastModified

                End With

                UpdateSerials

            Next i

            rstSerials.Close

    Else

            .RemoveItem index

            .AddItem strNewRow

        End If

    End With

    ClearFields

    Me.Refresh

    SetStatus "Изменения были  успешно произведены"

Exit_Sub:

    Exit Sub

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub btnDelete_Click()

On Error GoTo Err_Handler

    If (lbxSoldGoods.ListIndex = -1) Then

        Err.Raise 513, CurrentObjectName, "Выберите элемент из списка  товаров"

    End If

    If (MsgBox("Вся информация  об покупке данного товара  будет удалена. Продолжить?", _

        vbExclamation + vbDefaultButton2 + vbOKCancel, "Предупреждение") <> vbOK) Then

        GoTo Exit_Sub

    End If

    Dim qdfSerial As QueryDef

    Dim rstSerial As Recordset

    ' Create a temporary QueryDef object

    Set qdfSerial = CurrentDb.CreateQueryDef("")

    With qdfSerial

        .Connect = ""

        .SQL = "DELETE FROM Серийные WHERE Штрихкод_товара='" & _

            lbxSoldGoods.Column(0, lbxSoldGoods.ListIndex + 1) & "'"

        .Execute

    End With

    UpdateSerials

    lbxSoldGoods.RemoveItem lbxSoldGoods.ListIndex + 1

    ClearFields

    SetStatus "Информация из списка товаров была удалена"

Exit_Sub:

    Exit Sub

 

Err_Handler:  'обработка ошибок

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub btnNew_Click()

    ClearFields

    'UpdateVendorAssort

End Sub

 

Private Sub btnNewSale_Click()

    ClearFields

End Sub

 

Private Sub cbxBarCode_AfterUpdate()

On Error GoTo Err_Handler

    If (IsNull(cbxBarCode)) Then