[ Φόρμες ] Δημιουργία τυχαίων αριθμών

[mgeorge]

Καλησπέρα σε όλους,

Θα ήθελα την βοήθειά σας για μια ακόμη φορά.
Έχω μια φόρμα με τα εξής 3 πεδία (ΠΙΣΤΟΠΟΙΗΤΙΚΟ, ΑΡΙΘΜΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ, ΚΩΔΙΚΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ).
Θα ήθελα πατώντας την εντολή (ΔΗΜΙΟΥΡΓΙΑ ΤΥΧΑΙΩΝ ΚΩΔΙΚΩΝ) να δημιουργεί και στα 3 πεδία κάποιους τυχαίους αριθμούς οι οποίοι κάθε φορά να είναι μοναδικοί,θα πρέπει όμως να υπάρχουν οι εξής προυποθέσεις για το κάθε πεδίο.
1)Στο πεδίο (ΠΙΣΤΟΠΟΙΗΤΙΚΟ) ο τυχαίος αριθμός θα πρέπει να ξεκινάει από 1 και να είναι 6ψήφιος.
2) Στο πεδίο (ΑΡΙΘΜΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ) ο τυχαίος αριθμός θα πρέπει να ξεκινάει από 1700 και να είναι 9ψήφιος.
3)Στο πεδίο (ΚΩΔΙΚΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ) ο τυχαίος αριθμός θα πρέπει να ξεκινάει από 000 και να είναι 9ψήφιος.

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

[kapetang]

Καλησπέρα

Γιώργο, ελπίζω να κατάλαβα σωστά το ζητούμενο.

Στην επισυναπτόμενη ΒΔ έκανα τις ακόλουθες αλλαγές:

1) Επειδή το τελευταίο πεδίο αρχίζει από «000», άλλαξα τα πεδία από αριθμητικά σε πεδία κειμένου.

2) Για να αποθηκεύουν διαφορετικές τιμές, δημιούργησα ευρετήρια που δεν επιτρέπουν διπλότυπες.

3) Πρόσθεσα τον παρακάτω κώδικα.

Private Sub cmdRnd_Click()
    Dim j As Integer
    On Error Resume Next
    For j = 1 To 10
        With Me.Recordset
            .AddNew
            .Fields("ΠΙΣΤΟΠΟΙΗΤΙΚΟ") = CreateRdn("1", 6)
            .Fields("ΑΡΙΘΜΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ") = CreateRdn("1700", 9)
            .Fields("ΚΩΔΙΚΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ") = CreateRdn("000", 9)
            .Update
        End With
    Next
    Me.Recordset.MoveLast
    On Error GoTo 0
End Sub


Public Function CreateRdn(ByVal strStart As String, Digits As Integer) As String
    Dim j As Integer
    For j = 1 To Digits - Len(strStart)
        strStart = strStart & Int(Rnd() * 10)
    Next
    CreateRdn = strStart
End Function

Αν πατήσουμε το κουμπί θα προστεθούν στον πίνακα 10 ή λιγότερες ( αν μία εγγραφή δημιουργεί διπλότυπα δεν αποθηκεύεται) εγγραφές .

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

[mgeorge]

Καλησπέρα Γιώργο,
Αυτό ζητάω αλλά δεν λειτουργεί στην βάση μου,προφανώς προσθέτει νέες εγγραφές αλλά όταν υπάρχουν ήδη καταχωρημένες εγγραφές οι οποίες έχουν ήδη πάρει ήδη αριθμό αναγνωριστικού δεν παίζει,έχεις καμιά ιδέα;

Σε ευχαριστώ!

[kapetang]

Γιώργο, στη βάση σου άλλαξες τον τύπο δεδομένων των πεδίων;

[mgeorge]

Ναι,τον άλλαξα,για την ακρίβεια αντέγραψα τα πεδία στην βάση μου όπως τα είχες αλλά δεν μπορώ να καταλάβω γιατί δεν παίζει.

[kapetang]

Μήπως υπάρχουν και άλλα πεδία στον πίνακα;
Ο κώδικας προσθέτει εγγραφές στον πίνακα. Δεν κάνει ενημέρωση παλιών εγγραφών.

[kapetang]

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

Στον κώδικα αυτό, είναι ενεργοποιημένα τα μηνύματα λαθών οπότε ευκολότερα θα καταλάβεις τι φταίει.

Private Sub cmdRnd_Click()
    Dim j As Integer
    Dim str1 As String, str1700 As String, str000 As String

    On Error GoTo Err_Handler

    For j = 1 To 10
        str1 = CreateRdn("1", 6)
        Do While DCount("*", "Πίνακας1", "ΠΙΣΤΟΠΟΙΗΤΙΚΟ='" & str1 & "'") > 0
            str1 = CreateRdn("1", 6)
        Loop

        str1700 = CreateRdn("1700", 9)
        Do While DCount("*", "Πίνακας1", "ΑΡΙΘΜΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ='" & str1700 & "'") > 0
            str1700 = CreateRdn("1", 6)
        Loop

        str000 = CreateRdn("000", 9)
        Do While DCount("*", "Πίνακας1", "ΚΩΔΙΚΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ='" & str000 & "'") > 0
            str000 = CreateRdn("000", 9)
        Loop

        With Me.Recordset
            .AddNew
            .Fields("ΠΙΣΤΟΠΟΙΗΤΙΚΟ") = str1
            .Fields("ΑΡΙΘΜΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ") = str1700
            .Fields("ΚΩΔΙΚΟΣ_ΠΙΣΤΟΠΟΙΗΤΙΚΟΥ") = str000
            .Update
        End With
    Next
    Me.Recordset.MoveLast
Exit_Sub:
    Exit Sub
Err_Handler:
    MsgBox "Error #" & Err.Number & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Error"
    Resume Exit_Sub
End Sub


Public Function CreateRdn(ByVal strStart As String, Digits As Integer) As String
    Dim j As Integer
    For j = 1 To Digits - Len(strStart)
        strStart = strStart & Int(Rnd() * 10)
    Next
    CreateRdn = strStart
End Function