تعديل كود تحدبث حالة الطالب

**جلال محمد** · مايو 30, 2016

السلام عليكم

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

ولكن الكود به خطأ تم اكتشافة اثناء العمل

الشرح في الملف المرفق

تعديل كود.rar

**ابو عبدالبارى** · مايو 30, 2016

اقتباس

كنترول الصف الثانى الثانوى شامل المجموعة العلمية والمجموعة الأدبية والمنازل

السلام عليكم

ربما يساعدك هذا الموضوع فى سؤالك

**ناصر سعيد** · مايو 31, 2016

14 ساعات مضت, جلال محمد said:

السلام عليكم

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

ولكن الكود به خطأ تم اكتشافة اثناء العمل

اخي الكريم

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

الكود في اوله نكتب اسماء المواد .... نفترض انك كتبت اسماء 6 مواد بما فيهم المجموع

اذن المطلوب هو كتابة ارقام الاعمدة ال6 بنقس تسلسلها

ومطلوب كتابه ارقام الاعمده ال6 بنفس تسلسلها التي يوجد بها اختبار الترم التاني

كده تمام .. طيب كل ماده من المواد التي كتبتها لها رقم عمود اللي فيه الدرجه النهائيه

وكل ماده لها اختبار الترم التاني

ماعدا المجموع ..لانه لايوجد له اختبار الترم التاني

الحل

تختاررقم عمود من اخر الصفحة ليكون بمثابه اختبار الترم التاني ونضع فيه نصف درجه المجموغ الكلي

جزاك الله خيرا

**جلال محمد** · مايو 31, 2016

الأخ بو عبادي

شكرا جزيلا علي سرعة ردك ...... وجزاك الله خيرا

اخي الكريم ناصر سعيد

شكرا علي ردك .... ولاكن

الكود انا استخدمة من مدة طويلة ولم يظهر بة هذة المشكلة الا هذا العام ...

والمتاح لك اضافة بياناتك في الجزء العلوي من الكود وتحديدا في هذا الجزء

شاهد الصورة

**ناصر سعيد** · مايو 31, 2016

من فضلك ضع الكود كاملا

17 ساعات مضت, ابو عبدالبارى said:

كنترول الصف الثانى الثانوى شامل المجموعة العلمية والمجموعة الأدبية والمنازل

السلام عليكم

ربما يساعدك هذا الموضوع فى سؤالك

تفيده ازاي وانت قافل الصفحات وقافل الاكواد مجرد سؤال .. جزاك الله خيرا

الاستاذ جلال انت طلبت الكود الخاص بحاله الطالب ووضعت جزء من كود الدوائر

**ابو عبدالبارى** · مايو 31, 2016

استاذى العزيز

ناصر سعيد

بعد التحية

أولا هذا الملف قد قمت بطرحة فى احد الموضوعات السابقة فى المنتدى تحت اسم شيت كنترول الصف الثانى الثانوى بقسمية العلمى والأدبى والمنازل وقد سبق ان قلت فى الموضوع الأصلى ان كلمة السر للصفحات ومحرر الأكواد هى 123 هلى هذا يفى بالجواب على سؤالك

ثانيا الملف الذى ارسلة الأستاذ جلال محمد

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

وشكرا على ملاحظاتك

**جلال محمد** · يونيو 1, 2016

الإخوة الكرام

السلام عليكم

انا ارسلت لكم في المشاركة الأولي ملف وبه الكود .... أستاذ ناصر كود الدوائر بداخلة كود تحديث حالة الطالب

واليكم الملف مرة أخري ... وشكرا جزيلا لكم

تعديل مواد الصف الثاني.rar

**جلال محمد** · يونيو 1, 2016

اخي الكريم

ابو عبدالبارى

انا ارسلت الملف وبة الكود الذي بة المشكلة حتي يكون التركيز علي المشكلة نفسها ..... اما باقي الأكواد لا تفيد الموضوع في شيء

**ناصر سعيد** · يونيو 2, 2016

اخي الكريم لم تفلح معي غده محاولات للوقوف على علاج القصور ولذا وجب التعرف على الكود الاصلي للعلامه باقشير ضع رابط هذا الكود لعمل مقارنه والوقوف على نقطه الخلاف ... وشكرا

**جلال محمد** · يونيو 2, 2016

اخي الكريم ناصر

اشكرك جزيل الشكر علي محاولاتك وتعبك ... وجزاك الله خيرا

عموما اليك الملف الذي حصلت منه علي هذا الكود ....

كشف درجات الصف الثاني الابتدائي_4.rar

**ابو عبدالبارى** · يونيو 2, 2016

في ١‏/٦‏/٢٠١٦ at 00:12, جلال محمد said:

اخي الكريم

ابو عبدالبارى

انا ارسلت الملف وبة الكود الذي بة المشكلة حتي يكون التركيز علي المشكلة نفسها ..... اما باقي الأكواد لا تفيد الموضوع في شيء

11 ساعات مضت, جلال محمد said:

اخي الكريم ناصر

اشكرك جزيل الشكر علي محاولاتك وتعبك ... وجزاك الله خيرا

عموما اليك الملف الذي حصلت منه علي هذا الكود ....

كشف درجات الصف الثاني الابتدائي_4.rar

اخى العزيز

بارفاقك الملف الأصلى ساعدنى كثيرا للوصول الى الحل ان شاء الله أرجو أن يفى الملف بحل المشكلة

اما بالنسبة الملف المرفوع شيت الصف الثانى الثانوى بالمشاركة السابقة انا اردت ان تجربة واذا اعجبك طريقة عملة سوف ارفع شيت كنترول للصف الأول ويعمل بنفس الطريقة

تقبل تحياتى......

تعديل مواد الصف الثاني.rar

**ناصر سعيد** · يونيو 2, 2016

Dim MyBoolean As Boolean
Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ActiveSheet.Shapes("الدائرة")
With XX.TextFrame.Characters
    If .Text = "اضافة الدوائر" Then
       Circles1
       .Text = "حذف الدوائر"
    Else
       Kh_DeletShape
       .Text = "اضافة الدوائر"
    End If
End With
On Error GoTo 0
End Sub
Sub Circles1()
On Error Resume Next
Dim MyRng_All As Range, c As Range
Dim V As Shape, S As String
Dim K As Integer, x As Integer, d As Long, N As Integer
Dim عمود_رقم_الجلوس As Integer, صف_مواد_دور_ثاني As Integer, صف_الدرجات As Integer
Dim عمود_حالة_الطالب As Integer, عمود_المواد As Integer
'================================================
عمود_رقم_الجلوس = 2
صف_الدرجات = 12
صف_مواد_دور_ثاني = 8
عمود_حالة_الطالب = 51
عمود_المواد = 52
Set MyRng_All = Range("p13:ax65529")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
x = ActiveWindow.Zoom
Application.ScreenUpdating = False
Range("ay13:az65529").ClearContents
ActiveWindow.Zoom = 100
For Each c In MyRng_All
    K = c.Column
    If Cells(c.Row, عمود_رقم_الجلوس) = 0 Then GoTo 3
    If Cells(صف_مواد_دور_ثاني, c.Column) <> "م" Then
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or c.Value = "غ" Or c.Value = "غـ") Then
            If MyBoolean Then GoTo 1
            Kh_AddShape c, V
            d = d + 1
        End If
1
    Else
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or Cells(c.Row, c.Column - 1) < Cells(صف_الدرجات, c.Column - 1) Or Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ") Then
            If Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ" Then N = N + 1
            '================================================
'           ترحيل مواد دورثاني ان وجدت
            If Cells(c.Row, عمود_المواد) = "" Then S = "" Else S = " - "
            Cells(c.Row, عمود_المواد) = Cells(c.Row, عمود_المواد) & S & Cells(صف_مواد_دور_ثاني - 1, c.Column)
            '================================================
            If MyBoolean Then GoTo 2
            Kh_AddShape c, V
            d = d + 1
        End If
    End If
   '================================================
'           ترحيل حالة الطالب
2
    If K = MyRng_All.Columns.Count + MyRng_All.Column - 1 Then
        If N = 4 Then Cells(c.Row, عمود_حالة_الطالب) = "غائب": Cells(c.Row, عمود_المواد) = "جميع المواد" _
        Else If Cells(c.Row, عمود_المواد) = "" Then Cells(c.Row, عمود_حالة_الطالب) = "ناجح ومنقول للصف الثالث" Else Cells(c.Row, عمود_حالة_الطالب) = "له دور ثاني في"
        N = 0
    End If
   '================================================
3 Next
ActiveWindow.Zoom = x
Application.ScreenUpdating = True
If MyBoolean Then GoTo 4
MsgBox "تم إضافة   " & d & "   دائرة بنجاح" & Chr(10) & Chr(10) & "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
On Error GoTo 0
4 End Sub
Sub Kh_AddShape(MyCell As Range, Kh_shp As Shape)
    Set Kh_shp = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left, MyCell.Top, MyCell.Width, MyCell.Height)
    With Kh_shp
        .Fill.Visible = msoFalse
        .Line.ForeColor.SchemeColor = 10
        .Line.Weight = 2.25
    End With
End Sub
Sub Kh_DeletShape()
    Dim myshape As Shape, d As Long
    For Each myshape In ActiveSheet.Shapes
      If myshape.Type = 1 Then myshape.Delete: d = d + 1
    Next myshape
MsgBox "تم حذف   " & d & "   دائرة بنجاح", vbMsgBoxRight, "الحمدلله"
End Sub
Sub تحديث()
MyBoolean = True
Circles1
MyBoolean = False
MsgBox "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
End Sub

جزاك الله كل حير استاذ ابو عبد الباري

ايه كانت المشكله في هذا الكود البطيء عندي هل عندكم بنقس البطء ..

تم تعديل يونيو 2, 2016 بواسطه ناصر سعيد

**ابو عبدالبارى** · يونيو 3, 2016

18 ساعات مضت, ناصر سعيد said:


Dim MyBoolean As Boolean
Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ActiveSheet.Shapes("الدائرة")
With XX.TextFrame.Characters
    If .Text = "اضافة الدوائر" Then
       Circles1
       .Text = "حذف الدوائر"
    Else
       Kh_DeletShape
       .Text = "اضافة الدوائر"
    End If
End With
On Error GoTo 0
End Sub
Sub Circles1()
On Error Resume Next
Dim MyRng_All As Range, c As Range
Dim V As Shape, S As String
Dim K As Integer, x As Integer, d As Long, N As Integer
Dim عمود_رقم_الجلوس As Integer, صف_مواد_دور_ثاني As Integer, صف_الدرجات As Integer
Dim عمود_حالة_الطالب As Integer, عمود_المواد As Integer
'================================================
عمود_رقم_الجلوس = 2
صف_الدرجات = 12
صف_مواد_دور_ثاني = 8
عمود_حالة_الطالب = 51
عمود_المواد = 52
Set MyRng_All = Range("p13:ax65529")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
x = ActiveWindow.Zoom
Application.ScreenUpdating = False
Range("ay13:az65529").ClearContents
ActiveWindow.Zoom = 100
For Each c In MyRng_All
    K = c.Column
    If Cells(c.Row, عمود_رقم_الجلوس) = 0 Then GoTo 3
    If Cells(صف_مواد_دور_ثاني, c.Column) <> "م" Then
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or c.Value = "غ" Or c.Value = "غـ") Then
            If MyBoolean Then GoTo 1
            Kh_AddShape c, V
            d = d + 1
        End If
1
    Else
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or Cells(c.Row, c.Column - 1) < Cells(صف_الدرجات, c.Column - 1) Or Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ") Then
            If Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ" Then N = N + 1
            '================================================
'           ترحيل مواد دورثاني ان وجدت
            If Cells(c.Row, عمود_المواد) = "" Then S = "" Else S = " - "
            Cells(c.Row, عمود_المواد) = Cells(c.Row, عمود_المواد) & S & Cells(صف_مواد_دور_ثاني - 1, c.Column)
            '================================================
            If MyBoolean Then GoTo 2
            Kh_AddShape c, V
            d = d + 1
        End If
    End If
   '================================================
'           ترحيل حالة الطالب
2
    If K = MyRng_All.Columns.Count + MyRng_All.Column - 1 Then
        If N = 4 Then Cells(c.Row, عمود_حالة_الطالب) = "غائب": Cells(c.Row, عمود_المواد) = "جميع المواد" _
        Else If Cells(c.Row, عمود_المواد) = "" Then Cells(c.Row, عمود_حالة_الطالب) = "ناجح ومنقول للصف الثالث" Else Cells(c.Row, عمود_حالة_الطالب) = "له دور ثاني في"
        N = 0
    End If
   '================================================
3 Next
ActiveWindow.Zoom = x
Application.ScreenUpdating = True
If MyBoolean Then GoTo 4
MsgBox "تم إضافة   " & d & "   دائرة بنجاح" & Chr(10) & Chr(10) & "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
On Error GoTo 0
4 End Sub
Sub Kh_AddShape(MyCell As Range, Kh_shp As Shape)
    Set Kh_shp = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left, MyCell.Top, MyCell.Width, MyCell.Height)
    With Kh_shp
        .Fill.Visible = msoFalse
        .Line.ForeColor.SchemeColor = 10
        .Line.Weight = 2.25
    End With
End Sub
Sub Kh_DeletShape()
    Dim myshape As Shape, d As Long
    For Each myshape In ActiveSheet.Shapes
      If myshape.Type = 1 Then myshape.Delete: d = d + 1
    Next myshape
MsgBox "تم حذف   " & d & "   دائرة بنجاح", vbMsgBoxRight, "الحمدلله"
End Sub
Sub تحديث()
MyBoolean = True
Circles1
MyBoolean = False
MsgBox "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
End Sub

جزاك الله كل حير استاذ ابو عبد الباري

ايه كانت المشكله في هذا الكود البطيء عندي هل عندكم بنقس البطء ..

تم التعديل ليكون الكود اسرع عندك لأنه بطئ عندى وعندكم ايضا وعند الأستاذ جلال محمد

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

ولكنى عندى بعض الملاحظات على الأستاذ جلال محمد لماذا لم يرسل الملف الذى يعمل علية كاملا لنستفيد به فى المنتدى لأنى لاحظت عدة ملاحظات به ولا اعرف كيفية تفاديها ومنها ( المواد بعد المجموع الكلى هى مواد نجاح ورسوب لماذا لا يأخذها فى الأعتبار فى مواد الرسوب ويأخذ فقط المواد ما قبل المجموع الكلى ) ارجو من الأستاذ جلال محمد الرد علينا

تعديل مواد الصف الثاني.rar

تم تعديل يونيو 3, 2016 بواسطه ابو عبدالبارى

**ناصر سعيد** · يونيو 3, 2016

Dim MyBoolean As Boolean
Sub اضافة_حذف()
On Error Resume Next
Dim XX As Shape
Set XX = ActiveSheet.Shapes("الدائرة")
With XX.TextFrame.Characters
    If .Text = "اضافة الدوائر" Then
       Circles1
       .Text = "حذف الدوائر"
    Else
       Kh_DeletShape
       .Text = "اضافة الدوائر"
    End If
End With
On Error GoTo 0
End Sub
Sub Circles1()
On Error Resume Next
Dim MyRng_All As Range, c As Range
Dim V As Shape, S As String
Dim K As Integer, x As Integer, d As Long, N As Integer
Dim عمود_رقم_الجلوس As Integer, صف_مواد_دور_ثاني As Integer, صف_الدرجات As Integer
Dim عمود_حالة_الطالب As Integer, عمود_المواد As Integer
'================================================
عمود_رقم_الجلوس = 2
صف_الدرجات = 12
صف_مواد_دور_ثاني = 8
عمود_حالة_الطالب = 51
عمود_المواد = 52
Set MyRng_All = Range("p13:ax1000")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
x = ActiveWindow.Zoom
Application.ScreenUpdating = False
Range("ay13:az1000").ClearContents
ActiveWindow.Zoom = 100
For Each c In MyRng_All
    K = c.Column
    If Cells(c.Row, عمود_رقم_الجلوس) = 0 Then GoTo 3
    If Cells(صف_مواد_دور_ثاني, c.Column) <> "م" Then
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or c.Value = "غ" Or c.Value = "غـ") Then
            If MyBoolean Then GoTo 1
            Kh_AddShape c, V
            d = d + 1
        End If
1
    Else
        If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or Cells(c.Row, c.Column - 1) < Cells(صف_الدرجات, c.Column - 1) Or Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ") Then
            If Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ" Then N = N + 1
            '================================================
'           ترحيل مواد دورثاني ان وجدت
            If Cells(c.Row, عمود_المواد) = "" Then S = "" Else S = " - "
            Cells(c.Row, عمود_المواد) = Cells(c.Row, عمود_المواد) & S & Cells(صف_مواد_دور_ثاني - 1, c.Column)
            '================================================
            If MyBoolean Then GoTo 2
            Kh_AddShape c, V
            d = d + 1
        End If
    End If
   '================================================
'           ترحيل حالة الطالب
2
    If K = MyRng_All.Columns.Count + MyRng_All.Column - 1 Then
        If N = 4 Then Cells(c.Row, عمود_حالة_الطالب) = "غائب": Cells(c.Row, عمود_المواد) = "جميع المواد" _
        Else If Cells(c.Row, عمود_المواد) = "" Then Cells(c.Row, عمود_حالة_الطالب) = "ناجح ومنقول للصف الثالث" Else Cells(c.Row, عمود_حالة_الطالب) = "له دور ثاني في"
        N = 0
    End If
   '================================================
3 Next
ActiveWindow.Zoom = x
Application.ScreenUpdating = True
If MyBoolean Then GoTo 4
MsgBox "تم إضافة   " & d & "   دائرة بنجاح" & Chr(10) & Chr(10) & "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
On Error GoTo 0
4 End Sub
Sub Kh_AddShape(MyCell As Range, Kh_shp As Shape)
    Set Kh_shp = ActiveSheet.Shapes.AddShape(msoShapeOval, MyCell.Left, MyCell.Top, MyCell.Width, MyCell.Height)
    With Kh_shp
        .Fill.Visible = msoFalse
        .Line.ForeColor.SchemeColor = 10
        .Line.Weight = 2.25
    End With
End Sub
Sub Kh_DeletShape()
    Dim myshape As Shape, d As Long
    For Each myshape In ActiveSheet.Shapes
      If myshape.Type = 1 Then myshape.Delete: d = d + 1
    Next myshape
MsgBox "تم حذف   " & d & "   دائرة بنجاح", vbMsgBoxRight, "الحمدلله"
End Sub
Sub تحديث()
MyBoolean = True
Circles1
MyBoolean = False
MsgBox "تم تحديث حالةالطالب" & Chr(10) & Chr(10) & "تم تحديث مواد دور ثاني", vbMsgBoxRight, "الحمدلله"
End Sub

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

**ابو عبدالبارى** · يونيو 3, 2016

شكرا لك استاذى العزيز / ناصر سعيد وعلى كلماتك الرقيقة

**ناصر سعيد** · يونيو 3, 2016

هل يمكن ان تشرح هذا الكود ليكون مرجعا لاحباننا في الله ولنا

جزاكم الله خيرا استاذ ابو عبد الباري

**ابو عبدالبارى** · يونيو 3, 2016

استاذى العزيز / ناصر محمد

سأقوم بشرح الجزئ الذى قدمت بالتعديل فيه فقط اما باقى الكود فهو يخص عالمنا الكبير / عبدالله باقشير

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

If IsNumeric(Cells(صف_الدرجات, c.Column)) And Not IsEmpty(Cells(صف_الدرجات, c.Column)) _
            And (c.Value < Cells(صف_الدرجات, c.Column) Or Cells(c.Row, c.Column - 1) < Cells(صف_الدرجات, c.Column - 1) Or Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ") Then
            If Cells(c.Row, c.Column - 1) = "غ" Or Cells(c.Row, c.Column - 1) = "غـ" Then N = N + 1

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

اما بالنسبة لتسريع الكود فانا قمت بتغيير الكود التالى بدلا من النطاق الكبير 65529 قمت باستبدالة 1000 لأنة اقصى عدد اى طلبة فى اى مدرسة لا يتجاوز 1000 طالب ولا يمكن ان يكون هناك هذا العدد الكبير ارجو ان تكون الفكرة وضحت

Set MyRng_All = Range("p13:ax65529")  ' نطاق الخلايا الذي تريد اضافة الدوائر فيها
'================================================
x = ActiveWindow.Zoom
Application.ScreenUpdating = False
Range("ay13:az65529").ClearContents

**ناصر سعيد** · يونيو 4, 2016

جزاك الله كل خير وبارك لك استاذ ابو عبد الباري

لو تكرمت شرحك مفهوم .. ولكن نقطه المجموع كيف تم حلها ؟

ممكن بفكرتك المفيده والرائعه في نقليل عدد الطلاب فزادت سرعه الكود .. هل يمكن اضافه ان هذا العدد يساوي عدد طلاب الصف الموجود بالصفحه الرئيسيه ... يدل ال 1000

**جلال محمد** · يونيو 4, 2016

اخي الكريم ابو عبد الباري

السلام عليكم

جزاك الله خيرا علي مجهودك العظيم ..... جعله الله في موازين حسناتك ان شاء الله

اقتباس

ولكنى عندى بعض الملاحظات على الأستاذ جلال محمد لماذا لم يرسل الملف الذى يعمل علية كاملا لنستفيد به فى المنتدى لأنى لاحظت عدة ملاحظات به ولا اعرف كيفية تفاديها ومنها ( المواد بعد المجموع الكلى هى مواد نجاح ورسوب لماذا لا يأخذها فى الأعتبار فى مواد الرسوب ويأخذ فقط المواد ما قبل المجموع الكلى ) ارجو من الأستاذ جلال محمد الرد علينا

اما بالنسبة للملف فهو علي الموقع من فترة طويلة العلمي والأدبي والصف الأول ......

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

واليكم الملف الأصلي علي الرابط التالي

http://www.kuwaiti.co/4y1ih206v3e4

اسم الدخول galal

كلمة السر 1111

**جلال محمد** · يونيو 4, 2016

الاخوة الكرام

الملف المرفق ارقام وبيانات حقيقية من واقع امتحانات هذا العام

ارجوا من الجميع تقييم الملف وذلك بعد تعديل الكود الزي قام بة الأستاذ / ابو عبدالبارى

**جلال محمد** · يونيو 4, 2016

اخي الكريم الأستاذ / ابو عبدالبارى

تفحصت الكود جيدا فلم الحظ اي تغير في اوامر الكود

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

وهذ الحل قد قمت فعلا بعملة اثاء ظهور النتيجة وعند ظهور هذة المشكلة

فهل من حل آخر ؟ او اضافة شرط في الكود يخص عمود المجموع الكلي

وشكرا للجميع

**ابو عبدالبارى** · يونيو 4, 2016

9 ساعات مضت, ناصر سعيد said:

جزاك الله كل خير وبارك لك استاذ ابو عبد الباري

لو تكرمت شرحك مفهوم .. ولكن نقطه المجموع كيف تم حلها ؟

ممكن بفكرتك المفيده والرائعه في نقليل عدد الطلاب فزادت سرعه الكود .. هل يمكن اضافه ان هذا العدد يساوي عدد طلاب الصف الموجود بالصفحه الرئيسيه ... يدل ال 1000

اخى العزيز ناصر سعيد

تشخيص المشكلة 90% من الحل وأنا شخصت المشكلة وشرحتها بالتفصيل وقدمت احد الحلول وتكت الملعب واسع لاحد الأخوة الزملاء يضعون فكرة اخرى للحل افضل من فكرتى

الحل كان : باضافة عمود فارغ قبل عمود المجموع الكلى واخفيته

**ابو عبدالبارى** · يونيو 4, 2016

29 دقائق مضت, جلال محمد said:

اخي الكريم الأستاذ / ابو عبدالبارى

تفحصت الكود جيدا فلم الحظ اي تغير في اوامر الكود

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

وهذ الحل قد قمت فعلا بعملة اثاء ظهور النتيجة وعند ظهور هذة المشكلة

فهل من حل آخر ؟ او اضافة شرط في الكود يخص عمود المجموع الكلي

وشكرا للجميع

اخى العزيز / جلال محمد

أولا / انا وضعت حلا فى حدود الملف المرسل لى فقط وقد اوضحت ذلك بعد ما قد طلب منك ارسال الملف كاملا للتعديل فية وانت رديت بانى ارسلت هذا الجزء لتسليط الضوء على هذا الجزء فقط وقد اجتهدت فى حدود المتاح. اما ولو ارسلت الملف كاملا كانت الفكرة ستتغير

ثانيا / وبعد ارسالك الملف كاملا وجدت ان هذا الحل يرسل النتائج فى العمود الذى يلى المجموع ( عمود الحاسب الآلى ) وهذا ايضا ناتج عن اقتصاص الملف ولكن يمكن التعديل فيه.

ثالثا / انا قدمت لك احد اعمالى فى المنتدى لشيت كنترول يجمع شعبتى العلمى وشعبتى الأدبى وكذلك المنازل مجمعين فى شيت واحد فقط بديلا (لشيت الشعبة العلمية -- لشيت الشعبة الأدبية - لشيت المنازل ) لتتفضل بدراسته والمقارنة وابداء الملاحظات بينه وبين الشيت الذى تعمل فلم ترد على

رابعا / أنا وصلت لتشخيص المشكلة وهى الآن امام جميع الأساتذة فى المنتدى لمحاولة ايجاد الحلول لها.

وتحياتى

**جلال محمد** · يونيو 4, 2016

اخي ابو عبد الباري

جزاك الله خيرا ..... وشكرا علي سعة صدرك

وانا اسف جدا لعرضي الموضوع بشكل اتعبك بعض الشيء

اما بالنسبة لملفك فهو رائع ..... ولكن انا افضل كل شيت علي حدا العلمي ... والأدبيي ..... والمنازل .... منفصلين عن بعض وخصوصا انا مدرستي لا يوجد بها منازل .

فلك كل الشكر والتقدير علي مجهودك .

**ابو عبدالبارى** · يونيو 4, 2016

1 ساعه مضت, جلال محمد said:

اخي ابو عبد الباري

جزاك الله خيرا ..... وشكرا علي سعة صدرك

وانا اسف جدا لعرضي الموضوع بشكل اتعبك بعض الشيء

اما بالنسبة لملفك فهو رائع ..... ولكن انا افضل كل شيت علي حدا العلمي ... والأدبيي ..... والمنازل .... منفصلين عن بعض وخصوصا انا مدرستي لا يوجد بها منازل .

فلك كل الشكر والتقدير علي مجهودك .

مشكور على كلماتك الرقيقة

ولكن انا لى ملحوظة على الشيت طرفكم المواد ما بعد المجموع الكلى ماذا لو رسب اى طالب بها لن تظهر فى مواد الرسوب لأنى لاحظت (انة لا يوجد طالب راسب فى هذه المواد ) ارجو أن تفيدنى بهذه المعلومة

اما بالنسبة لملفى انا قمت برفعه لأبداء الملاحظات علية ليس فرضا تطبيقة على مدرستكم ولكننى وجدت طلبات فى المنتدى فى احد الموضوعات خاصة بكنترول الثانى الثانوى وكذلك تفقيط الدرجات ومعاملة المنازل وكذلك بعض الأجزاء الفنية مثل التعامل مع الطالب المعفى من اللغة الثانية و كذلك بعض الأحصائيات التى تطلب فى المدارس للجودة وكذلك بعض الأضافات لكشوف المنادة مثل عد كل طلبة مادة معينة يعنى برنامج تجميعى لمجموعه من طلبات الزملاء فى كنترول بعض المدارس المعروفة لى ( يعنى تفصيل ) وانا رفعنه فى المنتدى على وعسى يوجد به بعض الأضافات أو الأخطاء اقوم بمعالجتها

ولك تحياتى

تسجيل الدخول

تعديل كود تحدبث حالة الطالب

الردود الموصى بها

جلال محمد

ابو عبدالبارى

ناصر سعيد

جلال محمد

ناصر سعيد

ابو عبدالبارى

ناصر سعيد

جلال محمد

جلال محمد

ابو عبدالبارى

ناصر سعيد

جلال محمد

ابو عبدالبارى

ابو عبدالبارى

ناصر سعيد

ابو عبدالبارى

ناصر سعيد

ابو عبدالبارى

ناصر سعيد

ابو عبدالبارى

ناصر سعيد

جلال محمد

جلال محمد

جلال محمد

ابو عبدالبارى

ابو عبدالبارى

جلال محمد

ابو عبدالبارى

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information