[ Φόρμες ] Διπλότυπη Εγγραφή σε πεδίο Υποφόρμας

[gianniskar]

Καλημερα σε ολους.Ανεβαζω ενα δειγμα της βασης μου.Η πρωτη φορμα που ανοιγει ειναι τα "Προσωπικα Στοιχεία".Αφου καταχωρησουμε καποια απαραιτητα στοιχεια ανοιγουμε την φορμα "Μαιευτική".Στα πεδια της υποφορμας "Περιστατικα Ιδ Ενδιαφερντος Εξωτερικων Μαιευτικης" στο πεδιο "Αριθμος Φακελου" γινεται να αποφευγεται η διπλοτυπη εγγραφη.Πχ οταν παει να γινει την ιδια στιμγη καταχωρηση στην δευτερη γραμμη της υποφορμας να μας εμφανιζει το σχετικο μηνυμα αν υπαρχει διπλοεγγραφη?

Στον κωδικα vba εχσω βαλει εναν κωδικα αλλα προφναως δεν δουλευει γιατι μαλλον δεν εχει αποθηκευτει πρωτα η εγγραφη

[Tasos]

Καλημέρα σε όλους!

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

στη σχεδίαση του πίνακα "Περιστατικα_Ιδ_Ενδιαφέρον� �ος_Εξωτερικών_Μαιευτικής" επίλεξε το πεδίο "Αριθμός Φακέλου"
και άλλαξε την ιδιότητα "Με ευρετήριο" σε "Ναι (Δεν επιτρέπονται διπλότυπα)".

Κατόπιν στη φόρμα "Περιστατικά_Ιδ_Ενδιαφέροντ ος_Εξωτερικών_Ιατρ_Μαιευτι� �ής"
αφού αφαιρέσεις το συμβάν "Αριθμός_Φακέλου_BeforeUpdate" , επικόλλησε τον παρακάτω κώδικα και αποθήκευσε:

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    If DataErr = 3022 Then
        Dim ret As VbMsgBoxResult
       MsgBox "Υπάρχει ήδη ο αριθμός φακέλου: '" & Me.Αριθμός_Φακέλου & _
                     "'" & vbLf & vbLf & "Πατήστε [ESC] για να ακυρώσετε την αποθήκευση", _
			 vbExclamation, "Διπλότυπη καταχώρηση"
        Me.Αριθμός_Φακέλου.Undo
        Me.Αριθμός_Φακέλου.SetFocus
        Me.Αριθμός_Φακέλου.SelStart = 0
        Me.Αριθμός_Φακέλου.SelLength = Len(Me.Αριθμός_Φακέλου.Text)
        Response = acDataErrContinue
    End If
End Sub

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

Τάσος

[gianniskar]

Τασο το εκανα αλλα μου βγαζει αυτο οπως βλεπεις στην εικονα

[Tasos]

Ιωάννη μου δεν έκανες δοκιμές στο παράδειγμα που ανέβασες αλλά σε άλλο αρχείο που συνδέεται με MSSQL. Δεν είναι το ίδιο πράγμα.

Δοκίμασε τα παρακάτω:

Αντικατέστησε τον κώδικα:

Private Sub Form_Error(DataErr As Integer, Response As Integer)
    If DataErr = 3022 Then
        Dim ret As VbMsgBoxResult
       MsgBox "Υπάρχει ήδη ο αριθμός φακέλου: '" & Me.Αριθμός_Φακέλου & _
                     "'" & vbLf & vbLf & "Πατήστε [ESC] για να ακυρώσετε την αποθήκευση", _
			 vbExclamation, "Διπλότυπη καταχώρηση"
        Me.Αριθμός_Φακέλου.Undo
        Me.Αριθμός_Φακέλου.SetFocus
        Me.Αριθμός_Φακέλου.SelStart = 0
        Me.Αριθμός_Φακέλου.SelLength = Len(Me.Αριθμός_Φακέλου.Text)
        Response = acDataErrContinue
    End If
End Sub

Με τον παρακάτω:

Private Sub Form_Error(DataErr As Integer, Response As Integer)
        MsgBox Dataerr
End Sub

και προσπάθησε να περάσεις μια διπλοεγγραφή για να δεις εάν, και ποιο νούμερο σφάλματος θα σου επιστρέψει (μπορεί να είναι και το 3621).

Κατόπιν επανέφερε τον αρχικό κώδικα και άλλαξε το 3022 με το νούμερο του μηνύματος (MsgBox) και δοκίμασε ξανά.

[gianniskar]

ok Τασο θα το διορθωσω και θα σου πω.

[gianniskar]

Kαλημερα.Το error ταν 3146.To αντικατέστησα και τωρα δουλευει.Σε ευχαριστω Τασο.

[Tasos]

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

[gianniskar]

Τασο θα το κοιταξω και θα σε ενημερωσω.Σε ευχαριστω