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

[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