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

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - Αποτροπή αρνητικού αθροίσματος σε Πίνακα (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/4849-apotropi-arnitikoi-athroismatos-se-pinaka.html)

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

Γεια σας

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

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

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

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

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

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

Καλημέρα σε όλους.
Δημήτρη μπορείς να δοκιμάσεις το εξής
πχ για τη φόρμα "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

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

Καλησπέρα

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

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

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

Αν και ίσως να αποτελεί υπερβολή για την περίπτωσή σου Δημήτρη, η πρότασή μου δράττει την ευκαιρία ώστε να ανοίξει το θέμα των συναλλαγών (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

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

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