كود اختيار بيانات عشوائية

مغلق

بدأه ابوحمود في 2 سبتمبر 2001 · 12 رد · 3,041 مشاهدة · في قسم الأرشيف و المواضيع المميزه

#12 سبتمبر 2001 في 05:52 صاحب الموضوع

 كود لاستخراج بيانات عشوائية من حقل أو استعلام أو عبارة 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

ولإستدعاء الدالة :

?FindRandom("RecordSetName", "FieldName")

حيث RecordSetName اسم جدول أو اسم استعلام أو عبارة SQL و FieldName اسم الحقل المطلوب استخراج البيانات العشوئية منه .

نقلا من أحد المواقع

ولكم تحياتي

#25 سبتمبر 2001 في 03:33

يعطيك العافيه ياأبو حمود بس الكود هذا وين يكتب بالنسبة لبرنامج الآكسس

وشكراٍ

#35 سبتمبر 2001 في 06:21

حسب رغبتك إذا بتستخدم الكود في أكثر من نموذج فضعه في الوحدة النمطية العامة وإذا في نموذج واحد فضعه في الوحدة النمطية الخاصة بالنموذج .

ولك تحياتي

#423 ديسمبر 2001 في 19:23

السلام عليكم ورحمة الله وبركاته وبعد ..

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

وأرغب من الأساتذة العباقرة الفطاحلة ... ألخ .. أن يتكرموا مشكورين بالأجابة علي هذا السؤال :

1- كيف لي أن أجعل البرنامج يقوم بأختيار رقم عشوائي من حقل الرقم في الجدول (جدول1 ) .. وذلك بواسطة زرين .. الأول 1- الأختيار بدون تكرار 2- الأختيار مع التكرار .. ؟

أملي أن أكون قد طرحت الموضوع بشكل واضح ..

الشكر مقدماً للجميع ..

#523 ديسمبر 2001 في 21:55

بالنسبة لطلبك الأول فجوابه في الأعلى أما الثاني اصبر علي بعض الوقت .

ولك تحياتي

#624 ديسمبر 2001 في 05:28

يعطيك العافية يابوحمود

انا حفظت الصفحة عندي ربما احتاج لها في المستقبل

#725 ديسمبر 2001 في 20:56

لجعل البيانات العشوائية غير متكررة يعني يظهر كل سجل مرة واحد فقط بدون أن يكرره حتى ولو كانت البيانات متككرة في الجدول في نفس الحقل :

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 ف أول الدالة واسم الحقل في سطر تطبيق الفلتر .

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

#827 ديسمبر 2001 في 11:06

السلام عليكم و رحمة الله و بركاته

هذا رابط لنفس الموضوع و تبدو الدالة مختصرة و لكن لم أجربها

http://www.vb4arab.com/vb/showthread.php?s...=&threadid=9239

==============

مع تحياتي

محمد طاهر

أوفيســـــــــــــــــــــنا

دورة تدريبية فى القراءة السريعة

===============

#927 ديسمبر 2001 في 11:35

لقد راجعت الدالة ينقصها الإعلان عن المتغيرات وعبارات اعتراض الخطأ ثم بعد تجربتها لم تؤدي المطلوب .

وقد قمت بالتعديل عليها حتى عدلت الناقص فيها :

Dim MyDB As Database
Dim MyRS As Recordset

Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset("ضع اسم جدول هنا", dbOpenDynaset)
If MyRS.RecordCount Then
MyRS.MoveLast
RecNo = CInt((MyRS.RecordCount * Rnd))  'Generate random value between 1 and RecordCount
MyRS.MoveFirst
'Go to the record pointed by the RecNo pointer
MyRS.Move RecNo
MsgBox MyRS.Fields(1).Value
End If
MyRS.Close

ولك تحياتي