TopPicLogo TopPicText

Обновление данных (формы) по справочнику (DAO)

В форму вводится уникальный идентификатор товара (в данном случае Штрих –код), а остальные поля заполняются из справочника.   
                       
В заголовок модуля формы помещаем описание типа данных с параметрами товара:

Private Type tpGood 'Пользовательский тип данных: Товар (для удобства)
'--------------------------------------------------------------------------
'Тип ТОВАР
Private Type tpGoodData
    Article As String   'Артикул
    Name As String      'Название
    Price As Currency   'Цена
    IsFound  As Boolean 'Найден - Нет
End Type
'--------------------------------------------------------------------------


Функция  поиска данных товара по штрих-коду:

Private Function GetGoodPrm(BarCode$) As tpGoodData
'es 28.07.2016
'Находит и устанавливает значения товара из справочника товаров (таблицы "dtGoods") по штрих-коду
'Возвращает Пользовательский тип данных: Товар (tpGoodData)
'--------------------------------------------------------------------------
Dim strSQL As String
Dim rst As DAO.Recordset
On Error GoTo GetGoodPrm_Err

'Строим набор с условием отбора по переданному в аргументе штрих-коду
    strSQL = "SELECT * FROM dtGoods WHERE gdBarCode = '" & BarCode & "';"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)  'dbOpenSnapshot = Только просмотр
    If rst.EOF = False Then 'Данные найдены
        With rst
            'Устанавливаем возвращаемые значения
            GetGoodPrm.Article = !gdArticle
            GetGoodPrm.Name = !gdname
            GetGoodPrm.Price = !gdPrice
            'Метка что Товар Найден
            GetGoodPrm.IsFound = True
        End With
    End If

GetGoodPrm_Bye:
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    Exit Function

GetGoodPrm_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: GetGoodPrm", vbCritical, "Error in module Form_Редактор"
    Resume GetGoodPrm_Bye
End Function

И наконец процедура заполнения полей данных товара по штрих-коду:

Private Sub txtBarCode_AfterUpdate()
'Реакция на обновление данных в поле "Штрих-код"
'--------------------------------------------------------------------------
Dim GoodData As tpGoodData

On Error GoTo txtBarCode_AfterUpdate_Err
    If IsNull(Me!txtBarCode) Then 'Длинна штрих кода 13 символов (обычно)
        'MsgBox "Введите Штрих-код", vbExclamation, "Ошибка ввода данных"
        Exit Sub
    End If

    GoodData = GetGoodPrm(Me!txtBarCode)  ' Ищем товар c указанным штрих-кодом и заполняем его параметры данными из справочника

    If GoodData.IsFound = True Then       ' Если товар c указанным штрих-кодом найден то:
        'Заполняем поля значениями
        Me!txtArticle = GoodData.Article
        Me!txtName = GoodData.Name
        Me!txtPrice = GoodData.Price
        'Метка времени
        Me!txtDate = Now()
        Me!txtTime.Requery 'поле времени из того же источника данных
    Else
        Me!txtBarCode.SetFocus 'Возврат фокуса в поле "Штрих-код"!
        MsgBox "Товар с данным Штрих-кодом не найден!", vbExclamation, "Ошибка поиска данных"
    End If

txtBarCode_AfterUpdate_Bye:
    Exit Sub

txtBarCode_AfterUpdate_Err:
    MsgBox "Ошибка " & Err.Number & vbCrLf & Err.Description & vbCrLf & "в процедуре: txtBarCode_AfterUpdate", vbCritical, "Error in module Form_frmSale"
    Resume txtBarCode_AfterUpdate_Bye
End Sub

Picture




Скачать

MSA-2007 Пример


Назад ToTop
L.E. 31.07.2016
Рейтинг@Mail.ru