[ Συναρτήσεις ] Έλεγχος Παλαιότερης Ημερομηνίας

[kapetang]

Καλημέρα

Χρήστο σ’ ευχαριστώ κ’ εγώ.

Κοιτάζοντας σήμερα τον κώδικα, με πιο καθαρό μυαλό, διαπίστωσα ότι το λάθος ήταν στη γραμμή κώδικα: If Me.Start <= minDate Or me.fDate >= maxDate Then.

Η γραμμή είναι λάθος στη λέξη Me.fDate (το πεδίο fDate δεν υπάρχει στη δική σου ΒΔ, ξέμεινε από το παράδειγμά μου), αντί όμως ο μεταγλωττιστής να σημειώνει λάθος τη λέξη Me.FDate σημείωνε παραπειστικά την Me.Start και με τρέλανε.

Παρακάτω υπάρχει ο κώδικας που αντιμετωπίζει όλες τις περιπτώσεις (και την τροποποίηση της ημερομηνίας έναρξης και της διάρκειας της άδειας).

Private Sub numDays_BeforeUpdate(Cancel As Integer)
    On Error GoTo Err_Hander

    If Not Me.NewRecord Then
        If Not IsNull(Me.numDays) Then
            If IsNull(Me.Start) Then
                Exit Sub
            Else
                If IsInvalidDate Then
                    Cancel = True
                End If
            End If
        End If
    End If
Exit_Sub:
    Exit Sub
Err_Hander:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Exit_Sub
End Sub

Private Sub Start_BeforeUpdate(Cancel As Integer)
' Έλεγχος παλαιότερης ημερομηνίας

    On Error GoTo Err_Handler

    'Η έναρξη πρέπει να είναι μεγαλύτερη από τη μέγιστη ημερομηνία [ΛήξηΆδειας]
    If IsNull(Me.Start) Then Exit Sub
    If Me.NewRecord Then
        If Me.Start <= Nz(DMax("[ΛήξηΆδειας]", "[qry_Adeies]", "[Μητρώο] ='" & Me.Μητρώο & "'"), 0) Then
            MsgBox "Η ημερομηνία δεν υπερβαίνει τις προηγούμενες"
            Cancel = True
        End If
    Else
        If Not IsNull(Me.numDays) Then
            If IsInvalidDate Then
                Cancel = True
            End If
        End If
    End If
Exit_Sub:
    Exit Sub
Err_Handler:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Exit_Sub
End Sub

Private Function IsInvalidDate() As Boolean
    Dim LastDateSKA As Date, DatesHemi As Integer, DateEnd As Date
        Dim minDate As Date, maxDate As Date, strC As String
        
        If Me.Parent.Ημερήσιος Then
            LastDateSKA = LastWorkingAbsenceDate(Me.Start, Me.numDays)
        Else
            LastDateSKA = Me.Start - 1 + Me.numDays
        End If
        
        If Me.Parent.Ημερήσιος Then
            DatesHemi = countHmiargiwn(Me.Start, Me.numDays, LastDateSKA)
        Else
            DatesHemi = 0
        End If
        DateEnd = LastWorkingAbsenceDate(LastDateSKA + 1, DatesHemi, 1)
            
        strC = "[Μητρώο] ='" & Me.Μητρώο & "' And [ID] < " & Me.ID
        minDate = Nz(DMax("[ΛήξηΆδειας]", "[qry_Adeies]", strC), 0)
        strC = "[Μητρώο] ='" & Me.Μητρώο & "' And [ID] > " & Me.ID
        maxDate = Nz(DMin("[Start]", "[qry_Adeies]", strC), #1/1/9999#)
        
        If Me.Start <= minDate Or DateEnd >= maxDate Then
            MsgBox "Η νέα ημερομηνία πρέπει να είναι μεγαλύτερη από τη μέγιστη των ημερομηνιών [ΛήξηΆδειας]" _
        & vbCrLf & "των προηγούμενων αδειών και η [ΛήξηΆδειας] μικρότερη της ελάχιστης των [Start] των επόμενων"
            IsInvalidDate = True
        End If
   
End Function

Αν νομίζεις ότι αξίζει τον κόπο και έχεις χρόνο, μπορείς να τον προσθέσεις στην εφαρμογή και να τον δοκιμάσεις καλύτερα.

Φιλικά/Γιώργος
ΥΓ Φυσικά και θυμάμαι. Βέβαια δε θυμάμαι τις λεπτομέρειες των συναρτήσεων,γι' αυτό δοκίμασε καλύτερα τον κώδικα, αν τον χρησιμοποιήσεις

[kapetang]

Καλησπέρα

Χρήστο κοίταξα λίγο καλύτερα τη ΒΔ σου και διαπίστωσα ότι η τελευταία μέρα απουσίας ενός εργαζόμενου δεν είναι η [ΛήξηΆδειας], αλλά η [ΤελευταίαΜέρα] .

Δηλαδή αν την Παρασκευή συμπληρώνεται η άδειά του αυτός θα λείπει και το Σαββατοκύριακο.

Η τελευταία μέρα είναι αυτή που θα πρέπει να λαμβάνεται υπόψη στους ελέγχους που κάνουμε.

Επειδή η πληροφορία είναι σημαντική θα πρότεινα να προσθέσεις κ’ αυτή στη σχετική φόρμα.

Η ημερομηνία έναρξης μιας άδειας [Start] και η ημερομηνία [ΤελευταίαΜέρα] ορίζουν το χρονικό διάστημα απουσίας του εργαζόμενου (απουσιάζει από [Start] μέχρι και [ΤελευταίαΜέρα]).

Όταν προσθέτουμε μία άδεια ή τροποποιούμε μια παλιά το χρονικό διάστημα που ορίζει (από [Start] μέχρι και [ΤελευταίαΜέρα]) δεν πρέπει να τέμνεται με τα χρονικά διαστήματα που ορίζουν οι άλλες άδειες του εργαζόμενου.

Με βάση τον κανόνα αυτό δημιούργησα για τους ελέγχους τον παρακάτω κώδικα, που είναι σαφέστερος, γενικότερος (δουλεύει και σε άδειες που δεν καταχωρούνται με τη σειρά χορήγησης) και ταχύτερος από αυτόν που πρότεινα στο προηγούμενο μήνυμά μου.

Private Sub numDays_BeforeUpdate(Cancel As Integer)
    On Error GoTo Err_Hander

    If Not (IsNull(Me.numDays) Or IsNull(Me.Start)) Then
        If IsInvalidDate Then Cancel = True
    End If

Exit_Sub:
    Exit Sub
Err_Hander:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Exit_Sub
End Sub

Private Sub Start_BeforeUpdate(Cancel As Integer)

    On Error GoTo Err_Handler

    If Not (IsNull(Me.numDays) Or IsNull(Me.Start)) Then
        If IsInvalidDate Then Cancel = True
    End If

Exit_Sub:
    Exit Sub
Err_Handler:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Exit_Sub
End Sub

Private Function IsInvalidDate() As Boolean
        Dim LastDateSKA As Date, DatesHemi As Integer, EndDate As Date
        Dim strSQL, rs As DAO.Recordset
        
        On Error GoTo Err_Handler
        
        If Me.Parent.Ημερήσιος Then
            LastDateSKA = LastWorkingAbsenceDate(Me.Start, Me.numDays)
        Else
            LastDateSKA = Me.Start - 1 + Me.numDays
        End If
        
        If Me.Parent.Ημερήσιος Then
            DatesHemi = countHmiargiwn(Me.Start, Me.numDays, LastDateSKA)
            EndDate = LastWorkingAbsenceDate(LastDateSKA + 1, DatesHemi, 1)
        Else
            EndDate = Me.Start - 1 + Me.numDays
        End If
        
        strSQL = "SELECT Count(*) AS CountRec FROM qry_Adeies WHERE qry_Adeies.ID <>" & Me.ID _
                & " AND qry_Adeies.Μητρώο='" & Me.Μητρώο & "'" _
                & " AND qry_Adeies.Start<=#" & Format(EndDate, "m/d/yyyy") & "#" _
                & " AND qry_Adeies.ΤελευταίαΜέρα >= #" & Format(Me.Start, "m/d/yyyy") & "#"
    
        Set rs = CurrentDb.OpenRecordset(strSQL)
        If rs!CountRec > 0 Then
            IsInvalidDate = True
            MsgBox "Το διάστημα [Start, ΤελευταίΜέρα] της άδειας τέμνεται τουλάχιστον" & vbCrLf _
                  & "με ένα από τα χρονικά διαστήματα που ορίζουν οι υπόλοιπες άδειες"
        End If
Exit_Function:
        On Error Resume Next
        rs.Close
        Set rs = Nothing
        Exit Function
Err_Handler:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description
    Resume Exit_Function
 
End Function

Φιλικά/Γιώργος

[Free_Ghost]

Γιώργο ευχαριστώ για την επιπλέον επεξεργασία, αλλά δεν ξέρω εάν θα μπορέσω να την ενσωματώσω και ελέγξω το σούρουπο, διαφορετικά πάμε το άλλο Σαββατοκύριακο.

Ευχαριστώ και πάλι...

[kapetang]

Χρήστο, χωρίς άγχος, όποτε βρεις χρόνο