[مصمم هاوي]

(04-05-24, 01:45 AM)أبو خالد الشكري كتب : مرحبا بك
جرب الكود التالي الذي تحويله :
ولا تنس إضافة مرجع references لمكتبة
Microsoft ActiveX Data Objects

كود :

Sub SaveTotl()
   Dim Rs As New ADODB.Recordset
   Dim SQL As String = "select * from TBL_Final1"
   Rs.Open(SQL, DB, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
   Rs.MoveFirst
   Dim j As Integer
   For j = 0 To Rs.RecordCount - 1
       Dim ct As Integer = 0
       Dim cc As Integer = 0
       Dim bo As Boolean = False

       Dim I As Integer
       For I = 1 To 6
           If Rs.Fields(20 + I).Value >= 50 Then
               ct += Rs.Fields(20 + I).Value
               bo = False
           ElseIf Rs.Fields(20 + I).Value < 50 Then
               ct += Rs.Fields(20 + I).Value
               cc += 1
               bo = True
           End If
       Next I

       Rs.Fields(28).Value = ct
       Rs.Fields(31).Value = cc

       Select Case cc
           Case 0
               Rs.Fields(32).Value = "ناجح"
           Case 1 To 3
               Rs.Fields(32).Value = "مكمل"
           Case Is > 3
               Rs.Fields(32).Value = "راسب"
       End Select

       Dim tt As Double = (ct / 600) * 100
       Rs.Fields(29).Value = tt

       If tt >= 85 Then
           Rs.Fields(30).Value = "ممتاز"
       ElseIf tt >= 75 AndAlso tt <= 85 Then
           Rs.Fields(30).Value = "جيد جداً"
       ElseIf tt >= 65 AndAlso tt <= 75 Then
           Rs.Fields(30).Value = "جيد"
       ElseIf tt >= 50 AndAlso tt <= 65 Then
           Rs.Fields(30).Value = "مقبول"
       End If

       Rs.Update()
       Rs.MoveNext()
   Next j
End Sub

Function aa(ByVal cc As Integer)
   Select Case cc
       Case 0
           Rs.Fields(32).Value = "ناجح"
       Case 1 To 3
           Rs.Fields(32).Value = "مكمل"
       Case Is > 3
           Rs.Fields(32).Value = "راسب"
   End Select
End Function

بارك الله فيك أخي أبو خالد على سرعة ردّك
ولكن ظهر خطأ وسأرفق مثالاً بسيطاً بالدوت نت أتمنى منك مشكوراً أن تعدل عليه

---

هذا مثال صغير للتعديل عليه


  WindowsApplication1.rar (الحجم : 83.08 ك ب / التحميلات : 24)

---

أسف أرفقتُ قاعدة البيانات الخطأ

---

هذه قاعدة البيانات الصحيحة

  Data_Base.rar (الحجم : 571.17 ك ب / التحميلات : 27)