MyTetra Share
Делитесь знаниями!
Обновление данных (формы) по справочнику (DAO)
19.07.2018
06:43
Раздел: VBA - Access - msa.polarcom.ru - 04 Наборы Записей

Обновление данных (формы) по справочнику (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



MSA-2007 ( 530 kB) Пример

Прикрепленные файлы:
 
MyTetra Share v.0.52
Яндекс индекс цитирования