Εμφάνιση ενός μόνο μηνύματος
  #4  
Παλιά 02-11-11, 12:40
kapetang Ο χρήστης kapetang δεν είναι συνδεδεμένος
Όνομα: Γιώργος
Έκδοση λογισμικού Office: Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-06-2010
Μηνύματα: 3.674
Προεπιλογή

Καλησπέρα

Γιώργο, στη συνημμένη ΒΔ προσπάθησα να υλοποιήσω το ζητούμενο.

Πατώντας το κουμπί «Τυχαία σειρά» στη φόρμα «ΤΥΧΑΙΑ_ΚΑΤΑΝΟΜΗ»:

1. Διαγράφονται τα αρχικά δεδομένα του πίνακα «TableRandom», που πρόσθεσα στη βάση.

2. Προσαρτώνται τα δεδομένα του πίνακα «Πίνακα1» στον «TableRandom», αλλά με τους αθλητές σε τυχαία κατανομή στις διαδρομές, σειρές, κλπ.

3. Εμφανίζονται στη φόρμα τα στοιχεία με τυχαία σειρά.
Το ίδιο κουμπί χρησιμοποιείται για να εμφανίσουμε τα στοιχεία και σε κανονική σειρά.

Κάθε φορά που πατάμε το κουμπί «Τυχαία σειρά» δημιουργείται νέα τυχαία κατανομή
Τα παραπάνω υλοποιούνται με τον κώδικα:
Κώδικας:
Private Sub cmdRandom_Click()
    If Me.cmdRandom.Caption = "Τυχαία σειρά" Then
        CreateRandomTable
        Me.RecordSource = "TableRandom"
        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.[Α/Α], Πίνακας1.ΑΓΩΝΙΣΜΑ, Πίνακας1.ΚΑΤΗΓΟΡΙΑ, " & _
            " Πίνακας1.ΟΜΙΛΟΣ, Πίνακας1.Νο1, Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 1], Πίνακας1.Νο2, " & _
            " Πίνακας1.[ΑΡ ΔΕΛΤΙΟΥ 2], Πίνακας1.ΗΜΕΡΟΜΗΝΙΑ FROM Πίνακας1;"
    Set rs2 = CurrentDb.OpenRecordset(strSQL)

    strSQLStart = "Insert Into TableRandom ([Α/Α], [ΑΓΩΝΙΣΜΑ], [ΚΑΤΗΓΟΡΙΑ], [ΟΜΙΛΟΣ], " & _
            "[Νο1], [ΑΡ ΔΕΛΤΙΟΥ 1],[Νο2], [ΑΡ ΔΕΛΤΙΟΥ 2],[ΗΜΕΡΟΜΗΝΙΑ], [ΔΙΑΔΡ], [ΔΙΑΔΡΟΜΗ], [ΣΕΙΡΑ])" & _
            " 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![Α/Α] & ", '" & rs2![ΑΓΩΝΙΣΜΑ] & "', '" & rs2![ΚΑΤΗΓΟΡΙΑ] & "', '" & _
                rs2![ΟΜΙΛΟΣ] & "', '" & rs2![Νο1] & "', " & rs2![ΑΡ ΔΕΛΤΙΟΥ 1] & ", " & _
                IIf(IsNull(rs2![Νο2]), "Null", "'" & rs2![Νο2] & "'") & ", " & _
                IIf(IsNull(rs2![ΑΡ ΔΕΛΤΙΟΥ 2]), "Null", rs2![ΑΡ ΔΕΛΤΙΟΥ 2]) & ", " & _
                "#" & Format(rs2![ΗΜΕΡΟΜΗΝΙΑ], "m/d/yyyy") & "#, " & 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
Φιλικά/Γιώργος
Συνημμένα Αρχεία
Τύπος Αρχείου: mdb RandomShort.mdb (412,0 KB, 18 εμφανίσεις)
Απάντηση με παράθεση