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)

Free_Ghost 03-01-14 18:57
Έλεγχος Παλαιότερης Ημερομηνίας
 
Φίλοι μου θα ήθελα να μάθω πώς μπορώ με κώδικα να ελέγξω εάν η ημερομηνία που εισάγω σε ένα πλαίσιο δεν είναι παλαιότερη η ίση με τις ημερομηνίες που έχω είδη περάσει για το ίδιο άτομο.


Π.χ. ενώ βρίσκομαι σε έναν μισθωτό και έχω περάσει σε αυτόν 7-8 ημερομηνίες που εργάστηκε και από λάθος πάω να περάσω μια παλαιότερη από την τελευταία που έχω εισάγει εκεί θέλω να με προειδοποιεί.

kapetang 03-01-14 20:59
Καλησπέρα

Χρήστο θα μπορούσες στη φόρμα που καταχωρείς τις ημερομηνίες των μισθωτών να δημιουργήσεις ένα κανόνα επικύρωσης.

Αν υποθέσουμε ότι:

1) Ο πίνακας στον οποίο αποθηκεύονται οι ημερομηνίες λέγεται tblDates.

2) Το πεδίο της ημερομηνίας λέγεται fDate

3) Η ταυτότητα (πεδίο που προσδιορίζει μοναδικά το μισθωτό) EmpID

Ο κανόνας επικύρωσης μπορεί να υλοποιηθεί ως εξής:

1) Σε προβολή σχεδίασης της φόρμας, στην ιδιότητα Validation Rule (βρίσκεται στην καρτέλα Data), του πεδίου fDate, πληκτρολογούμε τον τύπο:

[fDate]>DMax("[fDate]";"[tblDates]";"[EmpID] =" & [EmpID]).

2) Στην ιδιότητα Validation Text, πληκτρολογούμε το μήνυμα που θα εμφανίζεται, όταν παραβιάζεται ο κανόνας.

Για παράδειγμα: Η ημερομηνία δεν υπερβαίνει τις καταχωρημένες.

Αν το EmpID είναι πεδίο κειμένου θα πρέπει να πληκτρολογήσεις τον τύπο:

[fDate]>DMax("[fDate]";"[tblDates]";"[EmpID] ='" & [EmpID] & "'").

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

kapetang 04-01-14 08:27
Καλημέρα

Χρήστο η λύση του προηγούμενου μηνύματος έχει αρκετά κουσούρια.

Για μια πιο ολοκληρωμένη λύση, θα πρότεινα τον παρακάτω κώδικα:

Κώδικας:
Private Sub fDate_BeforeUpdate(Cancel As Integer)
    Dim minDate As Date, maxDate As Date, strC As String
    If Me.NewRecord Then
        If Me.fDate <= Nz(DMax("[fDate]", "[tblDates]", "[EmpID] =" & [EmpID]), 0) Then
            MsgBox "Η ημερομηνία δεν υπερβαίνει τις προηγούμενες"
            Cancel = True
        End If
    Else
        'Αρχή σχολίων
        strC = "[EmpID] =" & [EmpID] & " And [ID] < " & Me.ID
        minDate = Nz(DMax("[fDate]", "[tblDates]", strC), 0)
        strC = "[EmpID] =" & [EmpID] & " And [ID] > " & Me.ID
        maxDate = Nz(DMin("[fDate]", "[tblDates]", strC), #1/1/9999#)
        If Me.fDate < minDate Or Me.fDate > maxDate Then
            MsgBox "Η νέα ημερομηνία πρέπει να είναι ανάμεσα στις υπάρχουσες"
            Cancel = True
        End If
        'τέλος σχολίων
    End If
End Sub
Το πεδίο ID στον κώδικα είναι το πρωτεύον κλειδί του πίνακα.

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

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

Free_Ghost 04-01-14 12:53
Δυστυχώς Γιώργο δεν μου δούλεψε κανένα, βασικά το πρόβλημα πιστεύω πώς είναι στο :

Η ταυτότητα (πεδίο που προσδιορίζει μοναδικά το μισθωτό) EmpID

Το πεδίο EmpID δεν είναι μοναδικό μπορεί να υπάρχει 5,10, 15 φορές αυτό υποδουλώνει της εγγραφές στον συγκεκριμένο μισθωτό.

Δηλαδή η βάση δουλεύει με δύο πίνακες ο ένας περιέχει τα στοιχεία του μισθωτού όπου εκεί το πεδίο EmpID είναι μοναδικό και ο άλλος πίνακας περιέχει τις εγγραφές των ημερών και συνδέονται μεταξύ τους με το πεδίο EmpID και με σχέση ένα προς πολλά.

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

Αυτό που κατάλαβα ότι πρέπει να κινηθώ με την Dmax - Dmin θα το παλέψω...

kapetang 04-01-14 14:49
1 Συνημμένο(α)
Καλησπέρα

Χρήστο, ο κώδικας που σου πρότεινα θα πρέπει να εισαχθεί στη φόρμα που καταχωρείς τις ημερομηνίες των μισθωτών.

Το πεδίο EmPID είναι πρωτεύον κλειδί στον πίνακα με τα ονόματα των μισθωτών (πχ Employees) και εξωτερικό στον πίνακα όπου καταχωρείς τις ημερομηνίες (πχ tblDates).

Όλα τα πεδία που αναφέρονται στον κώδικα, αφορούν τον πίνακα των ημερομηνιών (tblDates).

Δες και τη συνημμένη ΒΔ

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

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

Free_Ghost 04-01-14 17:22
1 Συνημμένο(α)
Γιώργο καλά ανέφερα προηγουμένως παίζουμε σπασμένο τηλέφωνο και για αυτό φταίω εγώ, συγνώμη για την αναστάτωση.

Εκ των υστέρων σου ανεβάζω μια πειραματική βάση για να κατανοήσεις πώς έχω το σύστημα όταν πάω να εισάγω μια καινούργια ημερομηνία.

Αυτό έπρεπε να το είχα κάνει από αρχής..:hammer-smilies-0004:

kapetang 04-01-14 20:20
1 Συνημμένο(α)
Καλησπέρα

Χρήστο έκανα την προσαρμογή, αλλά με προβλήματα στον κώδικα που αντιμετωπίζει την περίπτωση τροποποίησης παλιών αδειών

Τα σημειώνω ως σχόλια στον κώδικα.

Αν κατάλαβα καλά, όταν τροποποιούμε μια παλιά ημερομηνία η νέα ημερομηνία πρέπει να είναι ανάμεσα στη μέγιστη [ΗμερομηνίαΛήξης] ( στον κώδικα μεταβλητή minDate) των προηγούμενων αδειών και στην ελάχιστη [Start] (στον κώδικα μεταβλητή maxDate) των επόμενων.

Κανονικά θα πρέπει να εξετάζεται και η διάρκεια της άδειας, ώστε η λήξη της να μη είναι μέσα στην επόμενη άδεια ([ΗμερομηνίαΛήξης]< maxStart).

Ελπίζω να μπορέσεις να υλοποιήσεις και την περίπτωση τροποποίησης παλιών αδειών.

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

Free_Ghost 04-01-14 21:53
Δεν μπορώ να καταλάβω τη γίνεται Γιώργο, άλλες φορές δουλεύει άλλες όχι, ειδικά την πρώτη φορά πάντα χτυπάει κατόπιν δουλεύει...

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

Έτσι ακούγεται πιο απλό ??:hmm::hmm:

kapetang 04-01-14 22:45
Αν περιοριστούμε μόνο στις νέες εγγραφές ο παρακάτω κώδικας είναι αρκετός:

Κώδικας:
Private Sub Start_BeforeUpdate(Cancel As Integer)

'Η έναρξη πρέπει να είναι μεγαλύτερη από τη μέγιστη ημερομηνία [ΛήξηΆδειας]
    If Me.NewRecord Then
        If Me.Start <= Nz(DMax("[ΛήξηΆδειας]", "[qry_Adeies]", "[Μητρώο] ='" & Me.Μητρώο & "'"), 0) Then
            MsgBox "Η ημερομηνία δεν υπερβαίνει τις προηγούμενες"
            Cancel = True
        End If
    End If
End Sub

Free_Ghost 05-01-14 07:11
Γιώργο καλημέρα, είδα πώς το γύρισες στο ερώτημα για να βάλεις ημερομηνία λήξεις και όχι έναρξης και το οποίο βέβαια είναι το σωστό.:045:

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

Εφόσον η βάση ξεκινήσει για το 2014 από το μηδέν και κάθε άδεια ελέγχεται πλέον τότε νομίζω πώς δεν θα υπάρχει πρόβλημα.

Όσον αφορά εσένα Γιώργο δεν ξέρω πώς μπορώ να σε ευχαριστήσω για πολλοστή φορά διότι μέσω αυτού του Forum με έχεις ξελασπώσει πάρα πολλές φορές…:handshake:

Δεν νομίζω πώς αρκούν τα λόγια μα αφού μόνο αυτά διαθέτουμε μέσω του Forum Ευχαριστώ για άλλη μια φορά Γιώργο. :thanks::drinks::thanks:

Υ.Γ. Θυμήσου αυτή η εφαρμογή δέχτηκε άπειρη βοήθεια από εσένα για να την στήσω (στην κανονική έκδοση). :038:

kapetang 05-01-14 11:06
Καλημέρα

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

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

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

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

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

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

Η ημερομηνία έναρξης μιας άδειας [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 06-01-14 13:12
Γιώργο ευχαριστώ για την επιπλέον επεξεργασία, αλλά δεν ξέρω εάν θα μπορέσω να την ενσωματώσω και ελέγξω το σούρουπο, διαφορετικά πάμε το άλλο Σαββατοκύριακο.

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

kapetang 06-01-14 15:58
Χρήστο, χωρίς άγχος, όποτε βρεις χρόνο


Η ώρα είναι 02:57.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2