اختيار رقم عشوائي

[محمد طاهر عرفه]

مثال علي اختيار رقم عشوائي

مع السماح بالتكرار أو عدم السماح

( لابو حمود )

RANDOM_abuh.rar

[oui67]

ياشباب كيف أبحث عن مجموعة سجلات في جدول مختلف عن الجدول المربوط مع النموذج الموجود عليه حاليا وبعد ذلك أختار عشوائيا أحد هذه السجلات وبعد ذلك أضع قيمته في أحد الحقول الموجده في النموذج الحالي الموجود عليه حاليا وشكرا

[ashraf]

لعل هذا يفيدك .

 كود لاستخراج بيانات عشوائية من حقل أو استعلام أو عبارة SQL 
كود: 
--------------------------------------------------------------------------------
Function FindRandom (RecordSetName As String, Fieldname As String)

   Dim MyDB As Database
   Dim MyRS As Recordset
   Dim SpecificRecord As Long, i As Long, NumOfRecords As Long

   Set MyDB = CurrentDB()
   Set MyRS = MyDB.OpenRecordset(RecordSetName, dbOpenDynaset)
   On Error GoTo NoRecords
   MyRS.MoveLast
   NumOfRecords = MyRS.RecordCount
   SpecificRecord = Int(NumOfRecords * Rnd)
   If SpecificRecord = NumOfRecords Then
      SpecificRecord = SpecificRecord - 1
   End If
   MyRS.MoveFirst
   For i = 1 To SpecificRecord
      MyRS.MoveNext
   Next i
   FindRandom = MyRS(Fieldname)
   Exit Function

NoRecords:
   If Err = 3021 Then
      MsgBox "There Are No Records In The Dynaset", 16, "Error"
   Else
      MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _
         16, "Error"
   End If
   FindRandom = "No Records"
   Exit Function

End Function
 --------------------------------------------------------------------------------
ولإستدعاء الدالة : 
[code]
--------------------------------------------------------------------------------
?FindRandom("RecordSetName", "FieldName")
 --------------------------------------------------------------------------------

حيث RecordSetName اسم جدول أو اسم استعلام أو عبارة SQL و FieldName اسم الحقل المطلوب استخراج البيانات العشوئية منه . نقلا من أحد المواقع ولكم تحياتي **************************************************************** لجعل البيانات العشوائية غير متكررة يعني يظهر كل سجل مرة واحد فقط بدون أن يكرره حتى ولو كانت البيانات متككرة في الجدول في نفس الحقل : 1- أعلن عن متغيرين على مستوى الوحدة النمطية الخاصة بالنموذج :

--------------------------------------------------------------------------------
Dim الاختيار_الأخير
Dim MyRS As Recordset
 --------------------------------------------------------------------------------

2- ضع الدالة التالية في الوحدة النمطية الخاصة بالنموذج : كود: --------------------------------------------------------------------------------

Function FindRandom2(RecordSetName As String, Fieldname As String)
   Dim MyDB As Database
   Dim strSQL As String
   Dim SpecificRecord As Long, i As Long, NumOfRecords As Long
  
   If IsEmpty(الاختيار_الأخير) Then
   ' السطر التالي ضع فيه عبارة SQL للحقل المطلوب استخراج بياناته
   ' لاحظ أن خاصية فريد قد جعلت الى نعم اثناء تصميم الاستعلام
    strSQL = "SELECT DISTINCT [اسم الجدول].[اسم الحقل] FROM [اسم الجدول];"
    Set MyDB = CurrentDb()
    Set MyRS = MyDB.OpenRecordset(strSQL, dbOpenDynaset)
    Else
    ' الحقل الموجود في السطر التالي هو الحقل الذي نستخرج منه البيانات بدون تكرار
    ' أزل الفاصلة العلوية إذا كانت بيانات الحقل رقمية
    MyRS.Filter = "[اسم الحقل] <>'" & الاختيار_الأخير & "'"
    Set MyRS = MyRS.OpenRecordset(dbOpenDynaset)
    End If
   On Error GoTo NoRecords
   MyRS.MoveLast
   NumOfRecords = MyRS.RecordCount
   SpecificRecord = Int(NumOfRecords * Rnd)
   If SpecificRecord = NumOfRecords Then
      SpecificRecord = SpecificRecord - 1
   End If
   MyRS.MoveFirst
   For i = 1 To SpecificRecord
      MyRS.MoveNext
   Next i
   FindRandom2 = MyRS(Fieldname)
   الاختيار_الأخير = FindRandom2
   Exit Function

NoRecords:
   If Err = 3021 Then
      MsgBox "There Are No Records In The Dynaset", 16, "Error"
   Else
      MsgBox "Error - " & Err & Chr$(13) & Chr$(10) & Error, _
         16, "Error"
   End If
   FindRandom2 = "لا يوجد سجلات"
   ' السطر التالي لجعل الكود يبدأ من جديد بعد ظهور الرسائل بعدم وجود سجلات
   الاختيار_الأخير = Empty
   Exit Function

End Function

--------------------------------------------------------------------------------

3- مرر لها اسم الجدول واسم الحقل مع ملاحظة أن اسم الحقل يجب أن يطابق اسم الحقل في عبارة SQL ف أول الدالة واسم الحقل في سطر تطبيق الفلتر .

وللجميع التحية

****************************

مع التحية والشكر لأبو حمود / أشرف خليل