توزيع ديناميكيي للجان علي الطلبة

[ابوصلاح]

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

On Error GoTo Err:

    Dim mySQL As String
    Dim rst As Recordset
    Dim i As Double, J As Double
    
    If IsNull([cbo_saf]) Then
        MsgBox "اختر الصف اولا", vbCritical, "اوفيسنا"
    Else
       DoCmd.SetWarnings False
       DoCmd.RunSQL "UPDATE emthan_tbl_bianat SET emthan_tbl_bianat.lagna = 0 WHERE (((emthan_tbl_bianat.saf)=[forms]![frm_golos_sry]![cbo_saf]));"
       DoCmd.SetWarnings True
                
        mySQL = "Select * From emthan_tbl_bianat"
        mySQL = mySQL & " WHERE saf ='" & Me.cbo_saf & "'"
        mySQL = mySQL & " ORDER BY golos1"
        
        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst
        
        For J = 1 To Me.count_legan
            For i = 1 To Me.kk
                rst.Edit
                rst![lagna] = J
                rst.Update
                rst.MoveNext
            Next
        Next
        Me.Requery
    End If
Err:
    If Err.Number = 3121 Then
    Else
    End If

توزيع اللجان علي الطلبة.rar

[محمد أبوعبدالله]

3 ساعات مضت, ابوصلاح said:

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

هل تقصثد توزيع لجميع الصفوف مرة واحدة ؟

تحياتي

[ابوصلاح]

اختار الصف ومن ثم احدد رقم اللجنه  عدد اللجان

 

[محمد أبوعبدالله]

استبدل السطر

For J = 1 To Me.count_legan

بالتالي

For J = Nz(DMax("[lagna]", "emthan_tbl_bianat"), 0) + 1 To Nz(DMax("[lagna]", "emthan_tbl_bianat"), 0) + 1 + Me.count_legan

والكود كامل

On Error GoTo Err:

    Dim mySQL As String
    Dim rst As Recordset
    Dim i As Double, J As Double
    
    If IsNull([cbo_saf]) Then
        MsgBox "اختر الصف اولا", vbCritical, "اوفيسنا"
    Else
       DoCmd.SetWarnings False
       DoCmd.RunSQL "UPDATE emthan_tbl_bianat SET emthan_tbl_bianat.lagna = 0 WHERE (((emthan_tbl_bianat.saf)=[forms]![frm_golos_sry]![cbo_saf]));"
       DoCmd.SetWarnings True
                
        mySQL = "Select * From emthan_tbl_bianat"
        mySQL = mySQL & " WHERE saf ='" & Me.cbo_saf & "'"
        mySQL = mySQL & " ORDER BY golos1"
        
        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst
        
'        For J = 1 To Me.count_legan
        For J = Nz(DMax("[lagna]", "emthan_tbl_bianat"), 0) + 1 To Nz(DMax("[lagna]", "emthan_tbl_bianat"), 0) + 1 + Me.count_legan
            For i = 1 To Me.kk
            
                rst.Edit
                rst![lagna] = J
                rst.Update
                rst.MoveNext
            Next
        Next
        Me.Requery
    End If
Err:
    If Err.Number = 3121 Then
    Else
    End If

توزيع اللجان علي الطلبة_2.rar

تحياتي

[ابوصلاح]

تم التعديل ليكون الكود كالاتي 

On Error GoTo Err:

    Dim mySQL As String
    Dim rst As Recordset
    Dim i As Double, J As Double
    
    If IsNull([cbo_saf]) Then
        MsgBox "ÇÎÊÑ ÇáÕÝ ÇæáÇ", vbCritical, "ÇæÝíÓäÇ"
    Else
       DoCmd.SetWarnings False
       DoCmd.RunSQL "UPDATE emthan_tbl_bianat SET emthan_tbl_bianat.lagna = 0 WHERE (((emthan_tbl_bianat.saf)=[forms]![frm_golos_sry]![cbo_saf]));"
       DoCmd.SetWarnings True
                
        mySQL = "Select * From emthan_tbl_bianat"
        mySQL = mySQL & " WHERE saf ='" & Me.cbo_saf & "'"
        mySQL = mySQL & " ORDER BY golos1"
        
        Set rst = CurrentDb.OpenRecordset(mySQL)
        rst.MoveLast: rst.MoveFirst
        
'        For J = 1 To Me.count_legan
        For J = num_lagna To Nz(DMax("[lagna]", "emthan_tbl_bianat"), 0) + Me.count_legan
            For i = 1 To Me.kk
            
                rst.Edit
                rst![lagna] = J
                rst.Update
                rst.MoveNext
            Next
        Next
        Me.Requery
    End If
Err:
    If Err.Number = 3121 Then
    Else
    End If