VBA, MS Access MS Access в примерах

Сумма с накоплением в форме (Recordset)

По материалам: https://www.cyberforum.ru/ms-access/thread2872255.html


Модуль формы со всем необходимым:

Private Sub txtСумма_AfterUpdate()
'Обновление  суммы
'----------------------------------------------------------------------------------------
    Me![Сумма итог] = RecalcOneRecordSum(Me.Код, Me.txtСумма)
    Me.Dirty = False 'сохраняем запись ...
    If Me.NewRecord = False Then
        RecalcAllRecords Me.Код, Me![Сумма итог]
        Me.Refresh
    End If
End Sub
Private Sub RecalcAllRecords(lRecID As Long, cSum As Currency)
'Пересчёт ниже ...
'----------------------------------------------------------------------------------------
Dim rst As DAO.Recordset
Dim sVal$
'----------------------------------------------------------------------------------------
On Error GoTo RecalcAllRecords_Err
    sVal = "SELECT * FROM Таблица1 WHERE (Код>" & lRecID & ") ORDER BY Код"
    Set rst = CurrentDb.OpenRecordset(sVal, dbOpenDynaset)   'Открытие на редакцию
    
    With rst 'Перебор всех записей в наборе
        Do Until .EOF = True 'Цикл до конца набора
            .Edit
                cSum = cSum + Nz(!Сумма)
                ![Сумма итог] = cSum
            .Update
            .MoveNext
        Loop
        
    End With
 
RecalcAllRecords_End:
    On Error Resume Next
    Set rst = Nothing
    Err.Clear
    Exit Sub
 
RecalcAllRecords_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub" & _
           "RecalcAllRecords - Form_ФормаЛенточная01.", vbCritical, "Произошла ошибка!"
    Err.Clear
    Resume RecalcAllRecords_End
 
End Sub
Private Function RecalcOneRecordSum(lRecID As Long, cSum As Currency) As Currency
Dim sWhere As String, vVal
    sWhere = "Код < " & lRecID
    vVal = DMax("Код", "Таблица1", sWhere)
    sWhere = "Код = " & Nz(vVal, 0)
    vVal = DLookup("[Сумма итог]", "Таблица1", sWhere)
    RecalcOneRecordSum = Nz(vVal) + cSum
End Function




Скачать

MSA-2007 и выше ( 30 kB) Пример


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