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

        Exit Sub

    End If

    If (cbxBarCode.ListIndex = -1) Then

        Exit Sub

    End If

    Dim qdfGoods As QueryDef

    Dim rstGoods As Recordset

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfGoods = CurrentDb.CreateQueryDef("")

    With qdfGoods

       .Connect = strCurrentODBCConnectStr

       .ReturnsRecords = True

       .SQL = "EXECUTE GetGoodsByCode '" & cbxBarCode & "'"

       Set rstGoods = .OpenRecordset(dbOpenSnapshot)

    End With

    With rstGoods

        cbxName = !Название_товара

        .Close

    End With

    UpdateDescription

    cbxName.SetFocus

    SetStatus "Поля успешно заполнены по коду товара"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub cbxName_AfterUpdate()

On Error GoTo Err_Handler

    If (IsNull(cbxName)) Then

        Exit Sub

    End If

    If (cbxName.ListIndex = -1) Then

        Exit Sub

    End If

    Dim qdfGoods As QueryDef

    Dim rstGoods As Recordset

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfGoods = CurrentDb.CreateQueryDef("")

    With qdfGoods

       .Connect = strCurrentODBCConnectStr

       .ReturnsRecords = True

       .SQL = "EXECUTE GetGoodsByName '" & cbxName & "'"

       Set rstGoods = .OpenRecordset(dbOpenSnapshot)

    End With

    With rstGoods

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

        .Close

    End With

    UpdateDescription

    cbxPaymentType.SetFocus

    SetStatus "Поля успешно  заполнены названию товара"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

   Resume Exit_Sub

End Sub

 

Private Sub cbxPaymentType_AfterUpdate()

    If (cbxPaymentType.ListIndex = 2) Then

        EnableClientGroup

        Exit Sub

    End If

    DisableClientGroup

    If (cbxPaymentType.ListIndex = 3) Then

        cbxReplacementCode.Enabled = True

        Exit Sub

    End If

    cbxReplacementCode.Enabled = False

End Sub

 

Private Sub Form_Open(Cancel As Integer)

On Error GoTo Err_Handler

    InitColumns

    InitRowSources

    ClearFields

    DisableClientGroup

    'UpdateVendorAssort

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

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Public Sub ClearFields()

    cbxBarCode = Null

    cbxName = Null

    cbxPaymentType = cbxPaymentType.Column(0, 0)

    tbxCount = Null

    cbxReplacementCode = Null

   

    cbxClientPass = Null

    tbxFirstPayment = Null

    tbxMonthPayment = Null

    tbxPaymentTerm = Null

    UpdateDescription

    cbxReplacementCode.Enabled = False

    cbxBarCode.SetFocus

End Sub

 

Public Sub InitRowSources()

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

    cbxBarCode.RowSourceType = "Table/Query"

    cbxBarCode.RowSource = "qGetAllGoodsCodes"

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

    cbxName.RowSourceType = "Table/Query"

    cbxName.RowSource = "qGetAllGoodsNames"

'    CurrentDb.QueryDefs("qGetAllPaymentTypes").Connect = strCurrentODBCConnectStr

    cbxPaymentType.RowSourceType = "Value List"

    cbxPaymentType.RowSource = "Наличный;Безналичный;В кредит;Замена по гарантии"

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

    cbxReplacementCode.RowSourceType = "Table/Query"

    cbxReplacementCode.RowSource = "qGetAllReplacementCodes"

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

    cbxClientPass.RowSourceType = "Table/Query"

    cbxClientPass.RowSource = "qGetAllClientPass"

End Sub

 

Public Sub InitColumns()

    ClearListBox lbxSoldGoods

    With lbxSoldGoods

        .ColumnCount = 8

        .ColumnHeads = True

        .AddItem "Штрихкод;Название;Оплата;Кол-во;Cтоимость;Взноз;Ежемес.;Период", 0

        .ColumnWidths = "0.8 in;1.3 in;0.5 in;0.5 in;0.5 in;0.4 in;0.4 in;0.4 in;"

    End With

    UpdateSerials

    ClearListBox lbxSerials

End Sub

 

'return .listcount if not found

Public Function GetSoldGoodsIndex(strBarCode As String) As Long

    With lbxSoldGoods

        Dim i As Long

        For i = 0 To .ListCount - 1

            If (.ItemData(i) = strBarCode) Then

                GetSoldGoodsIndex = i

                Exit Function

            End If

        Next i

    End With

    GetSoldGoodsIndex = i

End Function

 

Private Sub btnExit_Click()

    On Error GoTo Err_Handler

    DoCmd.Close acForm, Me.Name

    DoCmd.OpenForm "Магазин"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Public Sub EnableClientGroup()

    cbxClientPass.Enabled = True

    tbxFirstPayment.Enabled = True

    tbxMonthPayment.Enabled = True

    tbxPaymentTerm.Enabled = True

    groupCredit.Enabled = True

End Sub

 

Public Sub DisableClientGroup()

    cbxClientPass.Enabled = False

    tbxFirstPayment.Enabled = False

    tbxMonthPayment.Enabled = False

    tbxPaymentTerm.Enabled = False

    groupCredit.Enabled = False

End Sub

 

 

Public Sub UpdateDescription()

On Error GoTo Err_Handler

    If (IsNull(cbxBarCode)) Then

        lblDescription.Caption = "Информация о товаре отсутствует"

        Exit Sub

    End If

    If (cbxBarCode.ListIndex = -1) Then

        lblDescription.Caption = "Информация о товаре отсутствует"

        Exit Sub

    End If

    Dim qdfGoods As QueryDef

    Dim rstGoods As Recordset

    'Dim strInfo As String

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfGoods = CurrentDb.CreateQueryDef("")

    With qdfGoods

       .Connect = strCurrentODBCConnectStr

       .ReturnsRecords = True

       .SQL = "EXECUTE GetGoodsByCode '" & cbxBarCode & "'"

      Set rstGoods = .OpenRecordset(dbOpenSnapshot)

    End With

    With rstGoods

        lblDescription.Caption = "Категория товара: " & !Категория  & vbCrLf & _

            "Цена: " & !Цена & vbCrLf & _

            !Описание

        .Close

    End With

   

    SetStatus "Описание товара успешно обновлено"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Public Function GetCurPrice() As Currency

On Error GoTo Err_Handler

    Dim qdfGoods As QueryDef

    Dim rstGoods As Recordset

    ' Create a temporary QueryDef object to retrieve

    ' data from a Microsoft SQL Server database.

    Set qdfGoods = CurrentDb.CreateQueryDef("")

    With qdfGoods

       .Connect = strCurrentODBCConnectStr

       .ReturnsRecords = True

       .SQL = "EXECUTE GetGoodsByCode '" & cbxBarCode & "'"

       Set rstGoods = .OpenRecordset(dbOpenSnapshot)

    End With

    With rstGoods

        GetCurPrice = !Цена * CLng(tbxCount)

        .Close

    End With

Exit_Sub:

    Exit Function

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

    ErrorHandler

    Resume Exit_Sub

End Function

 

Private Sub lbxSoldGoods_Click()

    With lbxSoldGoods

        cbxBarCode = .Column(0, .ListIndex + 1)

        cbxName = .Column(1, .ListIndex + 1)

        cbxPaymentType = .Column(2, .ListIndex + 1)

        tbxCount = .Column(3, .ListIndex + 1)

        tbxFirstPayment = .Column(5, .ListIndex + 1)

        tbxMonthPayment = .Column(6, .ListIndex + 1)

        tbxPaymentTerm = .Column(7, .ListIndex + 1)

    End With

    UpdateSerials

    UpdateDescription

End Sub

 

Public Sub UpdateSerials()

    With lbxSerials

        If (IsNull(cbxBarCode)) Then

            .RowSourceType = "Value List"

            .RowSource = ""

        Else

            .RowSourceType = "Table/Query"

            .RowSource = "SELECT Серийный_номер " & _

                        "FROM Серийные " & _

                        "WHERE Штрихкод_товара='" & cbxBarCode & "'"

        End If

        .Requery

    End With

End Sub

 

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

Рисунок 24 – Форма «Товар»

Кнопки «+» и «-» позволяют сохранить (добавить) или удалить оптовое предложение.

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

Private Sub btnCancel_Click()

On Error GoTo Err_Handler

    If (cbxBarCode.ListIndex = -1) Then

        ClearFields

    Else

        Dim qdfGoods As QueryDef

        Dim rstGoods As Recordset

   

        ' Create a temporary QueryDef object to retrieve

        ' data from a Microsoft SQL Server database.

        Set qdfGoods = CurrentDb.CreateQueryDef("")

        With qdfGoods

           .Connect = strCurrentODBCConnectStr

           .ReturnsRecords = True

           .SQL = "EXECUTE GetGoodsByCode '" & cbxBarCode & "'"

           Set rstGoods = .OpenRecordset(dbOpenSnapshot)

        End With

       

        With rstGoods

           

            cbxName = !Название_товара

            cbxCategory = !Категория

            tbxDescription = !Описание

            tbxCountWarehouse = !Количество_склад

            tbxCountStore = !Количество_магазин

            tbxPrice = !Цена

            tbxGarantee = !Срок_гарантии

            If (!Код_сервисного_центра <> 0) Then

                cbxServiceCentre = !Название_сервисного_центра

            Else

                cbxServiceCentre = ""

            End If

            .Close

        End With

        cbxBarCode.SetFocus

    End If

    UpdateVendorAssort

    SetStatus "Изменения были отменены"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub btnClose_Click()

On Error GoTo Err_Handler

    DoCmd.Close acForm, Me.Name

    DoCmd.OpenForm "Склад"

    SetStatus "Работа с формой Товар завершена"

Exit_Sub:

    Exit Sub

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

    ErrorHandler

    Resume Exit_Sub

End Sub

 

Private Sub btnDelete_Click()

On Error GoTo Err_Handler

    Dim qdfGoods As QueryDef

    Dim rstGoods As Recordset

    ' Create a temporary QueryDef object

    Set qdfGoods = CurrentDb.CreateQueryDef("")

    With qdfGoods

        .Connect = strCurrentODBCConnectStr

        .ReturnsRecords = False

        If (cbxBarCode.ListIndex = -1) Then

           Err.Raise 513, CurrentObjectName, "Нельзя удалить еще не сохраненные данные"

        End If

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

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