[kapetang]

Καλησπέρα και πάλι

Η υλοποίηση του ζητούμενου στη συνημμένη ΒΔ είναι παρόμοια μ’ αυτήν που παρουσιάζω στο προηγούμενο μήνυμα.

Είναι όμως καλύτερη:

1. Γιατί αντιμετωπίζει πληρέστερα τα προβλήματα, που μπορεί να δημιουργήσουν οι Null τιμές.

2. Ο κώδικας είναι πιο περιορισμένος και κατανοητός

Private Sub cmdRandom_Click()
    Dim strSQL As String
    If Me.cmdRandom.Caption = "Τυχαία σειρά" Then
        CreateRandomTable
        strSQL = "SELECT TableRandom.ΔΙΑΔΡ, TableRandom.ΔΙΑΔΡΟΜΗ, TableRandom.ΣΕΙΡΑ, " & _
        "Πίνακας1.[Α/Α], Πίνακας1.ΚΑΤΗΓΟΡΙΑ, Πίνακας1.ΟΜΙΛΟΣ, Πίνακας1.Νο1, " & _
        "Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 1], Πίνακας1.Νο2, Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 2], " & _
        "Πίνακας1.ΑΓΩΝΙΣΜΑ, Πίνακας1.ΗΜΕΡΟΜΗΝΙΑ " & _
        "FROM TableRandom INNER JOIN Πίνακας1 ON TableRandom.[Α/Α] = Πίνακας1.[Α/Α];"
        Me.RecordSource = strSQL
        Me.cmdRandom.Caption = "Κανονική σειρά"
    Else
        Me.RecordSource = "Πίνακας1"
        Me.cmdRandom.Caption = "Τυχαία σειρά"
    End If
End Sub
Sub CreateRandomTable()
    Dim strSQLStart As String
    Dim rs1 As DAO.Recordset, strSQL As String, rs2 As DAO.Recordset

    CurrentDb.Execute "Delete * From TableRandom"
    strSQL = "SELECT Πίνακας1.ΔΙΑΔΡ, Πίνακας1.ΔΙΑΔΡΟΜΗ, Πίνακας1.ΣΕΙΡΑ, " & _
            "Rnd([Α/Α]) as fShort    FROM Πίνακας1 Order by 4 ;"
    Set rs1 = CurrentDb.OpenRecordset(strSQL)

    strSQL = "SELECT Πίνακας1.[Α/Α] FROM Πίνακας1;"
    Set rs2 = CurrentDb.OpenRecordset(strSQL)

    strSQLStart = "Insert Into TableRandom ([Α/Α],  [ΔΙΑΔΡ], [ΔΙΑΔΡΟΜΗ], [ΣΕΙΡΑ]) Values( "
    If rs1.EOF And rs1.BOF Then
        rs1.Close: Set rs1 = Nothing: rs2.Close: Set rs2 = Nothing
        Exit Sub
    End If
    rs1.MoveFirst: rs2.MoveFirst

    Do Until rs1.EOF
        strSQL = strSQLStart & rs2![Α/Α] & ", " & rs1![ΔΙΑΔΡ] & ", " & _
                rs1![ΔΙΑΔΡΟΜΗ] & ", '" & rs1![ΣΕΙΡΑ] & "' );"
        CurrentDb.Execute strSQL
        rs1.MoveNext: rs2.MoveNext
    Loop
    If Not rs1 Is Nothing Then rs1.Close: Set rs1 = Nothing
    If Not rs2 Is Nothing Then rs2.Close: Set rs2 = Nothing
End Sub

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