Αποτροπή αρνητικού αθροίσματος σε Πίνακα

[dimitrisp]

Γεια σας

Στη δειγματική Βάση που ανέβασα, υπάρχουν ένας πίνακας [tblX] και τρεις ανεξάρτητες φόρμες
(frmA, frmB, frmC) .

Απο τις φόρμες καταχωρίζονται δεδομένα στον πίνακα. Στον πίνακα επιτρέπεται η καταχώρηση αρνητικών τιμών.

Πολλες φορές το αλγεβρικό άθροισμα στο πεδίο [POSO] για μια καταχώρηση που είναι ίδια στο πεδίο [KATASTIMA]
είναι αρνητικό (<0).

Για παράδειγμα, όπως φαίνεται στον πίνακα της βάσης που ανέβασα, για το
"ΚΑΤΑΣΤΗΜΑ4" (τρεις εγγραφές) το αλγεβρικό άθροισμα ισούται με -300: (100-300-100) = -300).

Είναι δυνατόν, όταν καταχωρίζουμε κάποια εγγραφή στον πίνακα διαμέσου των φορμών
και προκύπτει αρνητικό αλγεβρικό άθροισμα για ίδια εγγραφή του πεδίου [KATASTIMA],
τότε να μην επιτρέπεται η καταχώρηση της τρέχουσας εγγραφής και να εμφανίζεται σχετικό μήνυμα?


Σας ευχαριστώ εκ των προτέρων

[nasos23]

Καλημέρα σε όλους.
Δημήτρη μπορείς να δοκιμάσεις το εξής
πχ για τη φόρμα "frmA"

Option Compare Database
Option Explicit

Private Sub cboKatastimaA_AfterUpdate()
DoCmd.SetWarnings False
 Dim CRITERIA As String
   CRITERIA = DSum("POSO", "tblX", "KATASTIMA='" & Me.cboKatastimaA & "'") + Me.POSOA
     If Me.POSOA <> 0 And CRITERIA >= 0 Then
        DoCmd.RunSQL "INSERT INTO tblX (POSO,KATASTIMA ) VALUES (POSOB,cboKatastimaA )"
 Else
 MsgBox "Το άθροισμα των ποσών για το κατάστημα είναι αρνητικό!!", vbCritical, "Προσοχή!!"
 Me.POSOA.SetFocus
Exit Sub
End If
DoCmd.SetWarnings True

End Sub

Ομοίως και για τις άλλες φόρμες με τα ανάλογα πεδία.

[dimitrisp]

Καλησπέρα

Νάσο, σε υπερευχαριστώ για την πρότασή σου.
Ο κώδικας που πρότεινες λειτουργεί άψογα!
Είναι ακριβώς αυτό που ήθελα να πραγματοποιήσω.

Νάσαι καλά... Καλή συνέχεια...

[gmaster]

Γεια σας και από μένα!

Αν και ίσως να αποτελεί υπερβολή για την περίπτωσή σου Δημήτρη, η πρότασή μου δράττει την ευκαιρία ώστε να ανοίξει το θέμα των συναλλαγών (Transactions) οι οποίες αποτελούν τον πλέον σίγουρο τρόπο διασφάλισης των δεδομένων και των κανόνων μιας εφαρμογής. Όποια αλλαγή και να γίνει μετά την εντολή BeginTrans (Έναρξη συναλλαγής), μπορεί να αναιρεθεί πλήρως από την εντολή Rollback ή να αποθηκευτεί μόνιμα από την εντολή CommitTrans.

Έτσι, η καταχώρηση της τιμής για ένα κατάστημα θα μπορούσε να ανατεθεί στην παρακάτω συνάρτηση:

Public Function AppendValue(strKatastima As String, crrPoso As Currency) As Long
    Dim WS As dao.Workspace
    Dim CDB As dao.Database
    Dim lngRet As Long

    lngRet= 0

    If Len(strKatastima) > 0 Then
        Set WS = dao.DBEngine.Workspaces(0)
        Set CDB = CurrentDb
        On Error GoTo ErrHandler
        With WS
            'Έναρξη συναλλαγής
            .BeginTrans
            'Καταχώρηση τιμής
            CDB.Execute "INSERT INTO tblX (POSO, KATASTIMA) VALUES (" _
                              & crrPoso & ", '" & strKatastima & "');", dbFailOnError
            'Έλεγχος αθροίσματος
            If CDB.OpenRecordset("SELECT SUM([POSO]) AS SumP " _
                                       & "FROM tblX GROUP BY KATASTIMA " _
                                       & "HAVING (KATASTIMA='" & strKatastima & "')")![SumP] < 0 Then
                'Αναίρεση αλλαγών λόγω αρνητικού αθροίσματος
                .Rollback
                lngRet= -1
            Else
                'Εφαρμογή αλλαγών
                .CommitTrans
            End If
        End With
    End If
ExitHere:
    'Εκχώρηση επιστρεφόμενης τιμής στη συνάρτηση
    AppendValue = lngRet
    On Error Resume Next
    CDB.Close
    WS.Close
    Set CDB = Nothing
    Set WS = Nothing
    Exit Function
ErrHandler:
    'Αναίρεση αλλαγών λόγω σφάλματος χρόνου εκτέλεσης
    WS.Rollback
    'Εκχώρηση τιμής σφάλματος στη συνάρτηση
    lngRet= Err.Number
    Resume ExitHere
End Function

Ενώ ο χειρισμός της από τη φόρμα Α θα μπορούσε να έχει την παρακάτω μορφή:

Private Sub cboKatastimaA_AfterUpdate()
    With Me.POSOA
        If IsNull(.Value) Then
            MsgBox .ValidationText, vbExclamation
            .SetFocus
            Exit Sub
        End If
    End With
    
    With Me.cboKatastimaA
        If IsNull(.Value) Then
            MsgBox .ValidationText, vbExclamation
            .SetFocus
            Exit Sub
        End If
    End With

    Dim lngRet As Long
    lngRet = AppendValue(Me.cboKatastimaA, Me.POSOA)
    If lngRet = 0 Then
        MsgBox "Η καταχώρηση των " & FormatCurrency(Me.POSOA) & " ολοκληρώθηκε με επιτυχία!", vbInformation
    ElseIf lngRet = -1 Then
        'Απόρριψη καταχώρησης λόγω αρνητικού αθροίσματος
        MsgBox "Η καταχώρηση απορρίφθηκε!" & vbCrLf _
               & "Οδηγεί σε αρνητικό άθροισμα για το κατάστημα " & Me.cboKatastimaA, vbExclamation
    Else
        'Απόρριψη καταχώρησης λόγω σφάλματος χρόνου εκτέλεσης
        MsgBox "Η καταχώρηση απορρίφθηκε λόγω απροσδόκητου σφάλματος!" & vbCrLf & vbCrLf _
               & "Σφάλμα :" & lngRet & vbCrLf & Error(lngRet), vbExclamation
    End If
End Sub

Γενικώς, λεπτοί χειρισμοί στα δεδομένα θα πρέπει να γίνονται από όσο το δυνατό λιγότερα σημεία, έτσι ώστε και ο έλεγχος να είναι αποτελεσματικότερος αλλά και η εποπτεία και η συντήρηση ευκολότερη.

Καλή συνέχεια!