تسلم أخي الكريم و سلم يمينك و دينك .. ربّنا يبارك فيك و لك ودنيا و آخرة إن شاء الله و كل من تحب
شكري و تقديري لما قمت به عسى الله أن يعوّضك بأحسن و أفضل منها و يزيدك من علمه و فضله و ينفع بك الاسلام و المسلمين ..
ألقيت نظرة على الملف أخي الكريم .. بداية رائعة .. فعلا .. لكن كفكرة أخي الغالي .. بقي الجزء الأهم و هو الجزء المسؤول عن عملّية خلط الأسماء بالجدوليْن ..
تسلم أخي الكريم و سلم يمينك و دينك .. ربّنا يبارك فيك و لك ودنيا و آخرة إن شاء الله و كل من تحب
شكري و تقديري لما قمت به عسى الله أن يعوّضك بأحسن و أفضل منها و يزيدك من علمه و فضله و ينفع بك الاسلام و المسلمين ..
ألقيت نظرة على الملف أخي الكريم .. بداية رائعة .. فعلا .. لكن كفكرة أخي الغالي .. بقي الجزء الأهم و هو الجزء المسؤول عن عملّية خلط الأسماء بالجدوليْن ..
تحياتي و تقييماتي
لا اعلم ماذا اول فشكراً لك واشكر لله عى كل حال
وتقبل منك الدعاء لنا جميعاً باذن الله
عند انشاء الملف لك توقفت عند الكود For
لو اعطيتنى فكرة بدلاً من تحليل الكود كاملاً لمعرفة كرة الناتج
من الممكن انشاء كود اصغر وابسط يقوم بنفس الفكرة
لان كلما فتحت قاعدة البيانات اجد جدول واحد فقط وليس 2
وساقوم بارفاق المشروع النهائي بعد اتمام انهائه تماماً
بالتوفيق لك
{وَقُل رَّبِّ زِدْنِي عِلْمًا}
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى لكل من يقوم بالمساهمة
فى حل المشكلة او الاستفسار لديك فالجميع هنا يعمل
على مساعدة الاخرين لوجه الله وان تحتسب له اجر عند الله
Imports System
Imports System.Windows.Forms
Imports System.Data.OleDb
Imports Microsoft.VisualBasic
Imports VBto
Public Class Form1
Inherits System.Windows.Forms.Form
Dim DB As New VBtoConnection
Dim RS As New VBtoRecordSet
Dim RA As New VBtoRecordSet
Private Sub Command1_Click(sender As Object, e As EventArgs) Handles Command1.Click
If Convert.ToDouble(Trim(Text100.Text)) <= 0 Then
MsgBox("يجب أن يكون عدد الصفوف أكبر من الصفر", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Focus()
Exit Sub
End If
If Convert.ToDouble(Trim(Text200.Text)) <= 0 Then
MsgBox("يجب أن يكون عدد الأعمدة أكبر من الصفر", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text200.Focus()
Exit Sub
End If
If RS.State = 1 Then RS.Close()
RS.Open("Select Count([المسار الرسمي]) as RowsTotal From CANDIDAT Where [المسار الرسمي]<>''", DB)
If RS.RecordCount > 0 Then
If Not IsDBNull(RS.Fields("RowsTotal").Value) Then zRowsCount = RS.Fields("RowsTotal").Value Else zRowsCount = 0
Else
zRowsCount = 0
End If
If RS.State = 1 Then RS.Close()
RS.Open("Select Count([المتسابقين]) as ColsTotal From CANDIDAT Where [المتسابقين]<>''", DB)
If RS.RecordCount > 0 Then
If Not IsDBNull(RS.Fields("ColsTotal").Value) Then zColsCount = RS.Fields("ColsTotal").Value Else zColsCount = 0
Else
zColsCount = 0
End If
If RS.State = 1 Then RS.Close()
If zRowsCount <= 0 Then
MsgBox("لم يتم العثور على أسماء في حقل المسار الرسمي!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text100.Focus()
Exit Sub
End If
If zColsCount <= 0 Then
MsgBox("لم يتم العثور على أسماء في حقل المتسابقين!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text200.Focus()
Exit Sub
End If
If Convert.ToDouble(Trim(Text100.Text)) > zRowsCount Then
MsgBox("عدد الصفوف أكبر من عدد الأسماء في حقل المسار الرسمي!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text100.Focus()
Exit Sub
End If
If Convert.ToDouble(Trim(Text200.Text)) > Int(zColsCount / Convert.ToDouble(Trim(Text100.Text))) Then
MsgBox("عدد المتسابقين لايمكن أن يغطي عدد الأعمدة أكتب عدد أعمدة أصغر!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text200.Focus()
Exit Sub
End If
If RS.State = 1 Then RS.Close()
RS.Open("Select [المسار الرسمي] as zPathNames From CANDIDAT Where [المسار الرسمي]<>'' Order By [الرقم] ASC", DB)
If RS.RecordCount > 0 Then
RS.MoveFirst()
Else
If RA.State = 1 Then RA.Close()
MsgBox("لم يتم العثور على أسماء في حقل المسار الرسمي!!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text100.Focus()
Exit Sub
End If
If RA.State = 1 Then RA.Close()
RA.Open("Select [المتسابقين] as zRacersNames From CANDIDAT Where [المتسابقين]<>'' Order By [الرقم] ASC", DB)
If RA.RecordCount > 0 Then
RA.MoveFirst()
Else
If RA.State = 1 Then RA.Close()
MsgBox("لم يتم العثور على أسماء في حقل المسار الرسمي!!", MsgBoxStyle.OkOnly + MsgBoxStyle.Exclamation, "تنبيه")
Text100.Enabled = True
Text200.Enabled = True
Command1.Enabled = True
Me.Cursor = Cursors.Default
Text100.Focus()
Exit Sub
End If
Dim zPath_Random_Position As Short
Dim zRacer_Random_Position As Short
Dim Is_PathName_Added As Boolean
Dim Is_RacerName_Added() As Boolean
Dim Add_RacerStatus As Boolean
Dim zCounter As Short
Dim zCol As Short
Dim I As Short
Dim H As Short
Dim zPathNames() As String
Dim zRacersNames(,) As String
ReDim Is_RacerName_Added(Convert.ToDouble(Trim(Text200.Text)))
Randomize()
zPath_Random_Position = (zRowsCount * Rnd()) + 1
If zPath_Random_Position > zRowsCount Then zPath_Random_Position = zRowsCount
RS.AbsolutePosition = zPath_Random_Position
Is_PathName_Added = False
For zCol = LBound(zPathNames) To UBound(zPathNames)
If RS.Fields(0).Value = zPathNames(zCol) Then
Is_PathName_Added = True
Exit For
End If
Next
If Is_PathName_Added = False Then
zPathNames(zCounter) = Convert.ToString(RS.Fields(0).Value)
MSFlexGrid1.set_TextMatrix(MSFlexGrid1.Row, 1, zPathNames(zCounter))
Exit Do
End If
For zCol = 1 To Convert.ToDouble(Trim(Text200.Text))
Do
Randomize()
zRacer_Random_Position = (zColsCount * Rnd()) + 1
If zRacer_Random_Position > zColsCount Then zRacer_Random_Position = zColsCount
RA.AbsolutePosition = zRacer_Random_Position
For I = 1 To Convert.ToDouble(Trim(Text200.Text))
Is_RacerName_Added(I) = False
For H = 1 To zCounter
If RA.Fields(0).Value = zRacersNames(I, H) Then
Is_RacerName_Added(I) = True
Exit For
End If
Next
Next
Add_RacerStatus = True
For I = 1 To Convert.ToDouble(Trim(Text200.Text))
If Is_RacerName_Added(I) = True Then
Add_RacerStatus = False
Exit For
End If
Next
If Add_RacerStatus = True Then
zRacersNames(zCol, zCounter) = Convert.ToString(RA.Fields(0).Value)
MSFlexGrid1.set_TextMatrix(MSFlexGrid1.Row, 1 + zCol, zRacersNames(zCol, zCounter))
Exit Do
End If
Private Sub Prepare_MSFlexGrid(ByVal zColsCount As Short)
Dim I As Short
Dim zCounter As Short
For I = 0 To zColsCount - 1
If I = 0 Then
MSFlexGrid1.set_TextMatrix(0, I, "الصفوف")
MSFlexGrid1.set_ColWidth(I, 1300)
ElseIf I = 1 Then
MSFlexGrid1.set_TextMatrix(0, I, "المسار الرسمي :")
MSFlexGrid1.set_ColWidth(I, 2500)
Else
zCounter += 1
MSFlexGrid1.set_TextMatrix(0, I, "المتسابق " & zCounter & " :")
MSFlexGrid1.set_ColWidth(I, 2300)
End If
MSFlexGrid1.set_ColAlignment(I, 3)
Next
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
DB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application.StartupPath & "\DATABSE.mdb" : DB.Open()
15-05-18, 09:29 PM (آخر تعديل لهذه المشاركة : 15-05-18, 09:35 PM {2} بواسطة عبد العزيز البسكري.)
السّلام عليكم و رحمة الله و بركاته
أشكرك جزيل الشّكر أخي الكريم " elgokr " على نيّة المساعدة
جزاك الله خير الجزاء و زادها بموازين حسناتك إن شاء الله و أحسن إليك مثلما أحسنت إليّ بهذه الكلمات الطيّبة
تحياتي و تقديراتي
السّلام عليكم و رحمة الله و بركاته
بارك الله فيك و لك و جزاك خير الجزاء أخي الكريم " عبد الرؤوف " على المساعدة
أدعو الله أن يجعلها صدقة جارية لك ليوم الدين إن شاء الله
صحيح الكود لم يعطِ أي خطأ إلا بالأسطر الأولى التّعريفية لكن عند التنفيذ لم تظهر النتائج على الفليكس جريد
هل من الممكن أخي الكريم .. إستبدال الفليكس بالداتاجريد لأنّ تفكيري شل تماما بهذا الملف ووجدت صعوبة في نقل الأدوات الناتجة عن التحويل إلى ملف فيجوال ستيديو جديد .. ناهيك عن رزمة المكتبات النادرة
15-05-18, 11:12 PM (آخر تعديل لهذه المشاركة : 15-05-18, 11:13 PM {2} بواسطة عبد العزيز البسكري.)
السّلام عليكم و رحمة الله و بركاته
أخي الغالي " elgokr "
أحييك تحية خاصة على هذا العمل الرائع فعلا ً .. ربنا ينعم عليك بخيرات الدنيا و الآخرة بعد عمر طويل إن شاء الله
عمل فعلا مميّز .. فقط ملاحظة صغيرة .. لا حظ لو سمحت الصورة مثلا .. الأسماء المؤشر عليهم باللون الأصفر .. كلها متشابهة .. و من المفروض أن لا نجد شخص أكثر من مرة إذ لا يجوز منطقيا أن يكون هنا و هناك
لكل من يقوم بالمساهمة
