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/2896-elegxos-palaioteris-hmerominias.html)

Καλημέρα

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

Κοιτάζοντας σήμερα τον κώδικα, με πιο καθαρό μυαλό, διαπίστωσα ότι το λάθος ήταν στη γραμμή κώδικα: 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

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

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

Καλησπέρα

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

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

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

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

Η ημερομηνία έναρξης μιας άδειας [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

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

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

Ευχαριστώ και πάλι...:045::thanks::drinks::bye:

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