اذهب الي المحتوي
أوفيسنا

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

جلال محمد

بواسطه جلال محمد
في منتدى الاكسيل Excel

 مشاركة

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

جلال محمد

جلال محمد

قام بنشر
قام بنشر

السلام عليكم

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

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

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

تعديل كود.rar

رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر
14 ساعات مضت, جلال محمد said:

السلام عليكم

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

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

اخي الكريم

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

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

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

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

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

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

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

الحل

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

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

  • Like 1
رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

الأخ بو عبادي

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

 

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

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

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

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

شاهد الصورة

 

Untitled.jpg

  • Like 1
رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر

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

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

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

السلام عليكم

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

 

 

 

 

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

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

رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر

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

ناصر سعيد

بعد التحية 

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

السلام عليكم 

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

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

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

رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

اخي الكريم 

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

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

رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر

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

 

رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

رابط هذا التعليق
شارك
ابو عبدالبارى

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

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

اخي الكريم 

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

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

 

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

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

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

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

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

اخى العزيز

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر (معدل) 
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

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

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

 

تم تعديل بواسطه ناصر سعيد
رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر (معدل)
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

 

تم تعديل بواسطه ابو عبدالبارى
رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر 
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

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

رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر

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

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

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

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
رابط هذا التعليق
شارك
ناصر سعيد

ناصر سعيد

قام بنشر
قام بنشر

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

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

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

رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

السلام عليكم 

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

اقتباس

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

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

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

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

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

اسم الدخول galal

كلمة السر 1111

 

رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

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

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

 

رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

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

وشكرا للجميع

رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر

 

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

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

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

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

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

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

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

رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر
29 دقائق مضت, جلال محمد said:

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

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

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

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

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

وشكرا للجميع

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

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

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

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

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

وتحياتى

  • Like 1
رابط هذا التعليق
شارك
جلال محمد

جلال محمد

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

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

رابط هذا التعليق
شارك
ابو عبدالبارى

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

قام بنشر
قام بنشر
1 ساعه مضت, جلال محمد said:

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

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

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

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

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

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

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

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

ولك تحياتى

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept