Не связанная форма - Отправка данных в таблицу с реализацией "механизма транзакции"По материалам: https://www.cyberforum.ru/ms-access/thread3115148.html Часть кода из примера: Private Sub cmdAction_Click() ' Нажатие на кнопку "Применить!" ' -------------------------------------------------------------------------------------------------/ Dim rst As DAO.Recordset On Error GoTo cmdAction_Click_Err ' Проверка введённого: If Me.ComboТип.ListIndex = -1 Then MsgBox "Тип указан не верно!", vbExclamation, "Ошибка" Me.ComboТип.SetFocus Exit Sub End If If Not Nz(Me.TextСумма, 0) > 0 Then MsgBox "Сумма указана не верно!", vbExclamation, "Ошибка" Me.TextСумма.SetFocus Exit Sub End If ' Me.ComboТип.RowSource = "-1;Списание;0;Перевод;1;Поступление" Select Case Me.ComboТип Case -1 '-1; Списание If Me.ComboОтправитель.ListIndex = -1 Then MsgBox "Отправитель не указан!", vbExclamation, "Ошибка" Me.ComboОтправитель.SetFocus Me.ComboОтправитель.Dropdown Exit Sub End If If Me.TextСумма > CCur(Nz(Me.TextБалансОтправитель, 0)) Then MsgBox "Сумма превышает остаток!", vbExclamation, "Ошибка" Me.TextСумма = CCur(Nz(Me.TextБалансОтправитель, 0)) Me.TextСумма.SetFocus End If Case 0 '0; Перевод If Me.ComboОтправитель.ListIndex = -1 Then MsgBox "Отправитель не указан!", vbExclamation, "Ошибка" Me.ComboОтправитель.SetFocus Me.ComboОтправитель.Dropdown Exit Sub End If If Me.TextСумма > CCur(Nz(Me.TextБалансОтправитель, 0)) Then MsgBox "Сумма превышает остаток!", vbExclamation, "Ошибка" Me.TextСумма = CCur(Nz(Me.TextБалансОтправитель, 0)) Me.TextСумма.SetFocus End If If Me.ComboПолучатель.ListIndex = -1 Then MsgBox "Получатель не указан!", vbExclamation, "Ошибка" Me.ComboПолучатель.SetFocus Me.ComboПолучатель.Dropdown Exit Sub End If If Me.ComboОтправитель = Me.ComboПолучатель Then MsgBox "Отправитель и Получатель совпадают!", vbExclamation, "Ошибка" Me.ComboПолучатель.SetFocus Exit Sub End If Case 1 ' 1; Поступление If Me.ComboПолучатель.ListIndex = -1 Then MsgBox "Получатель не указан!", vbExclamation, "Ошибка" Me.ComboПолучатель.SetFocus Me.ComboПолучатель.Dropdown Exit Sub End If Case Else End Select ' -------------------------------------------------------------------------------------------------/ 'Дальше: Set rst = CurrentDb.OpenRecordset("Транзакции") 'Открытие на редакцию With rst .AddNew !Тип = Me.ComboТип !ОтправительSID = Nz(Me.ComboОтправитель, 0) !ПолучательSID = Nz(Me.ComboПолучатель, 0) !Сумма = Me.TextСумма !Назначение = Me.TextНазначение .Update End With rst.Close Set rst = Nothing Call RecountAll ComboОтправитель_AfterUpdate ComboПолучатель_AfterUpdate Me.TextСумма = 0 Me.TextСумма.SetFocus MsgBox "Операция успешно завершена.", vbInformation, "Ура-а-а-а!" ' -------------------------------------------------------------------------------------------------/ cmdAction_Click_End: On Error Resume Next Err.Clear Exit Sub ' -------------------------------------------------------------------------------------------------/ cmdAction_Click_Err: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub :" & _ "cmdAction_Click - Form_Транзакция.", vbCritical, "Error!" 'Debug.Print "cmdAction_Click_Line: " & Erl & "." Err.Clear Resume cmdAction_Click_End End Sub Private Sub RecountAll() 'Полный пересчёт! Dim sSQL$ sSQL = "UPDATE Клиенты SET Клиенты.Баланс = 0;" CurrentDb.Execute sSQL sSQL = "UPDATE Клиенты INNER JOIN Транзакции ON Клиенты.КлиентID = Транзакции.ПолучательSID SET Баланс = [Баланс]+[Сумма];" CurrentDb.Execute sSQL sSQL = "UPDATE Клиенты INNER JOIN Транзакции ON Клиенты.КлиентID = Транзакции.ОтправительSID SET Баланс = [Баланс]-[Сумма];" CurrentDb.Execute sSQL End Sub MSA-2007 и выше ( 63 kB) Пример |
|||
L.E. 12.07.2023 |