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/2740-dimioyrgia-tyxaion-arithmon.html)

Δημιουργία τυχαίων αριθμών

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

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

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

Καλησπέρα

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

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

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 ή λιγότερες ( αν μία εγγραφή δημιουργεί διπλότυπα δεν αποθηκεύεται) εγγραφές .

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

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

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

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

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

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

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

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

Κώδικας:

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