Приложение 3. Программное обеспечение формы формирования квитанции получения товара” (Kvit_In_f)

Option Compare Database

Dim bs As Database ' База данных

Dim tab_01, tab_02, tab_04 As Recordset ' Таблицы базы данных

' Поиск записи по первичному ключу методом дихотомии

Public Sub Find_Rec(r_tab As Recordset, ind As Integer)

Dim i, i1, i2, k As Integer

r_tab.MoveFirst

k = r_tab.Fields(0).Value

If k = ind Then Exit Sub ' Если индекс в первой записи = ind

r_tab.MoveLast

k = r_tab.Fields(0).Value

If k = ind Then Exit Sub ' Если индекс в последней записи = ind

i1 = 1 ' i1 := 1

i2 = r_tab.RecordCount ' i2 := количество_записей_в_таблице

While Abs(i1 - i2) <> 0 ' Пока не найдется запись с ключом ind

i = Int((i1 + i2) / 2)

' If i > r_tab.RecordCount Then i = r_tab.RecordCount

r_tab.MoveFirst

r_tab.Move (i)

k = r_tab.Fields(0).Value

If k = ind Then Exit Sub

If ind > k Then

i1 = i

Else

i2 = i

End If ' Конец If

Wend ' Конец цикла While

End Sub

' Добавить товар в квитанцию

Private Sub B_Add_Kvit_Click()

Dim Res

Dim Kol As Double

Dim ind As Integer

Set tab_04 = bs.OpenRecordset("Mesto_Chran") ' tab_04 связать с таблицей "Mesto_Chran"

Sel_Mesto_Chran.SetFocus ' Установить фокус на список мест хранения

ind = Sel_Mesto_Chran.Column(0) ' ind := првичный_индекс_места_хранения

Call Find_Rec(tab_04, ind) ' Встать на нужную запись в таблице "Mesto_Chran"

Kol = Kol_Tov.Value + tab_04.Fields(4).Value ' Прибавка товара в месте хранения

If Kol > tab_04.Fields(2).Value Then ' Вывод предупреждения

Res = MsgBox("Некуда складывать товар", vbOKOnly, "Предупреждение", "", 1000)

Exit Sub

Else

tab_04.Edit ' Разрешить редактирование таблицы "Mesto_Chran"

tab_04.Fields(4).Value = Kol ' Добавить кол-во хранимого товара

tab_04.Update ' Обновить результаты редактирования таблицы "Mesto_Chran"

End If

Set tab_02 = bs.OpenRecordset("Input") ' tab_02 связать с таблицей "Input"

tab_02.MoveLast ' Встать на последнюю запись таблицы "Input"

' tab_02.Edit

tab_02.AddNew ' Добавить запись в таблицу "Input"

tab_02.Fields(1).Value = ind_Kvit_In.Value

ind = Sel_Tov.Column(0)

tab_02.Fields(2).Value = ind 'Выбор товара

tab_02.Fields(3).Value = Kol_Tov.Value ' Выбор количества товара

tab_02.Fields(5).Value = tab_04.Fields(0) ' Выбор места хранения

tab_04.Close ' Закрыть таблицу "Mesto_Chran"

Set tab_04 = bs.OpenRecordset("Tovar") ' tab_04 связать с таблицей "Tovar"

ind = Sel_Tov.Column(0) '.ListIndex

Call Find_Rec(tab_04, ind) ' Встать на необходимуюую запись таблицы "Tovar"

Itogo.Value = Itogo.Value + Kol_Tov.Value * tab_04.Fields(3).Value ' Формирование итоговой стоимости квитанции

tab_02.Fields(4).Value = Kol_Tov.Value * tab_04.Fields(3).Value ' Выбор стоимости товара

tab_04.Edit ' Редактировать таблицу Tovar

Kol = tab_04.Fields(5).Value ' Kol := Количество_товара_на_складе

Kol = Kol + Kol_Tov.Value ' Прибавка товара на складе

tab_04.Fields(5).Value = Kol

tab_04.Update ' Обновить результаты редактирования таблицы "Tovar"

tab_02.Update ' Обновить результаты редактирования таблицы "Input"

Form_Kvit_In_F.Refresh ' Отобразить на форме результаты редактирования

End Sub

' Просмотр отчета по квитанции

Private Sub B_Ot_Kvit_In_F_Click()

On Error GoTo Err_B_Ot_Kvit_In_F_Click

Dim stDocName As String

Sel_Kladov.SetFocus ' Установить фокус на визуальный компонент Sel_Kladov

stDocName = "Kvit_Tovar_In_F"

DoCmd.OpenReport stDocName, acPreview

' B_Ot_Kvit_In_F.SetFocus ' Установить фокус на кнопке B_Ot_Kvit_In_F

Exit_B_Ot_Kvit_In_F_Click:

Exit Sub

Err_B_Ot_Kvit_In_F_Click:

MsgBox Err.Description

Resume Exit_B_Ot_Kvit_In_F_Click

End Sub

' Печать отчета по квитанции

Private Sub B_Print_Kvit_In_F_Click()

On Error GoTo Err_B_Print_Kvit_In_F_Click

Dim stDocName As String

Sel_Kladov.SetFocus ' Установить фокус на визуальный компонент Sel_Kladov

stDocName = "Kvit_Tovar_In_F"

DoCmd.OpenReport stDocName, acNormal

B_Print_Kvit_In_F.SetFocus ' Установить фокус на кнопке B_Print_Kvit_In_F

Exit_B_Print_Kvit_In_F_Click:

Exit Sub

Err_B_Print_Kvit_In_F_Click:

MsgBox Err.Description

Resume Exit_B_Print_Kvit_In_F_Click

End Sub

' Открытие формы

Private Sub Form_Open(Cancel As Integer)

Set bs = CurrentDb ' bs := текущую базу данных ("Sklad")

Set tab_01 = bs.OpenRecordset("Kvit_In") ' tab_01 связать с таблицей "Kvit_In"

tab_01.MoveLast ' Встать на последнюю запись таблицы "Kvit_In"

tab_01.AddNew ' Добавить запись в таблицу "Kvit_In"

tab_01.Fields(1).Value = Date + Time ' Вставить текущую дату/время

tab_01.Fields(2).Value = 1 ' Вставить в запись 1-го кладовщика (по умолчанию)

tab_01.Fields(3).Value = 0 ' Обнулить поле Itogo

tab_01.Update ' Обновить результаты редактирования таблицы "Kvit_In"

Form_Kvit_In_F.Refresh ' Отобразить на форме результаты редактирования

DoCmd.GoToRecord , "", acLast ' Отобразить на форме последнюю запись

End Sub

' Закрытие формы

Private Sub B_Close_Click()

On Error GoTo Err_B_Close_Click

DoCmd.Close

Exit_B_Close_Click:

Exit Sub

Err_B_Close_Click:

MsgBox Err.Description

Resume Exit_B_Close_Click

End Sub