Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Access > Access - Ερωτήσεις / Απαντήσεις > [ Φόρμες ] Δημιουργία τυχαίων αριθμών

Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια!

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 13-10-13, 15:23
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 07-05-2011
Μηνύματα: 137
Προεπιλογή Δημιουργία τυχαίων αριθμών

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

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

Σας ευχαριστώ εκ των προτέρων!!!
Συνημμένα Αρχεία
Τύπος Αρχείου: accdb Βάση δεδομένων1.accdb (356,0 KB, 13 εμφανίσεις)

Τελευταία επεξεργασία από το χρήστη Tasos : 13-10-13 στις 17:53.
Απάντηση με παράθεση
  #2  
Παλιά 13-10-13, 19:58
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα

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

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

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

Φιλικά/Γιώργος
Συνημμένα Αρχεία
Τύπος Αρχείου: accdb RandomValues.accdb (768,0 KB, 40 εμφανίσεις)
Απάντηση με παράθεση
  #3  
Παλιά 13-10-13, 22:27
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 07-05-2011
Μηνύματα: 137
Προεπιλογή

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

Σε ευχαριστώ!
Απάντηση με παράθεση
  #4  
Παλιά 13-10-13, 23:20
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Γιώργο, στη βάση σου άλλαξες τον τύπο δεδομένων των πεδίων;
Απάντηση με παράθεση
  #5  
Παλιά 13-10-13, 23:30
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 07-05-2011
Μηνύματα: 137
Προεπιλογή

Ναι,τον άλλαξα,για την ακρίβεια αντέγραψα τα πεδία στην βάση μου όπως τα είχες αλλά δεν μπορώ να καταλάβω γιατί δεν παίζει.
Απάντηση με παράθεση
  #6  
Παλιά 13-10-13, 23:55
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Μήπως υπάρχουν και άλλα πεδία στον πίνακα;
Ο κώδικας προσθέτει εγγραφές στον πίνακα. Δεν κάνει ενημέρωση παλιών εγγραφών.
Απάντηση με παράθεση
  #7  
Παλιά 14-10-13, 00:30
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

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

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

Κώδικας:
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
Απάντηση με παράθεση
Απάντηση στο θέμα


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Γενικά] Δημιουργία τυχαίων και μοναδικών 4ψήφιων αριθμών Skakinen Excel - Ερωτήσεις / Απαντήσεις 3 05-05-15 16:09
Παραγωγή τυχαίων αριθμών και εκτύπωση pm4698 Access - Ερωτήσεις / Απαντήσεις 1 03-11-14 20:38
Δημιουργία μοναδικών τυχαίων αριθμών kapetang Access samples - Χρήσιμα αρχεία & παραδείγματα 0 20-10-13 18:22
Εκτύπωση τυχαίων Εγγραφών και αριθμών Ms-Office-Development Team Access - Tips & Tricks 0 11-11-09 10:43
Εκτύπωση τυχαίων Εγγραφών και αριθμών kon73 Access - Ερωτήσεις / Απαντήσεις 0 06-02-09 12:53


Η ώρα είναι 19:34.