مساعدة على انجاز وحدة نمطية (module)

أخي الكريم

المطلوب يمكن أن يتم في استعلام وليس في وحدة نمطية

شكرا لك أخي mas123

هلا منحتني الاجابة في استعلام جزاك الله خيرا

Ahmed115 كتب:

شكرا لك أخي mas123

هلا منحتني الاجابة في استعلام جزاك الله خيرا

أتمنى أن يكون فهمي للجدول صحيحاً (رغم أني لا أجيد الفرنسية)

فهذا ما تم التوصل إليه

mas_bd1.rar

بعد إذن أستاذي القدير محمد صالح

لعل المطلوب يكون في وحدة نمطية بهذا الشكل:

Sub Gharram()
Dim Omr As Byte
Dim Categ As String, yrAge As String, Xx As Long, Nout As Long
Dim Rst As Recordset
Set Rst = CurrentDb.OpenRecordset("Table1")
If Rst.RecordCount > 0 Then
Rst.MoveFirst
Else
Exit Sub
End If
Do While Rst.EOF = False
Rst.Edit
yrAge = Rst!ANN_naiss
Xx = Rst!note_actuel
Omr = Year(Date) - CInt(yrAge)
If Omr > 30 Then
Categ = "A"
Nout = Xx + 3
Rst!nouv_categ = Categ
Rst!nouv_not = Nout
ElseIf Omr <= 30 And Omr >= 25 Then
Categ = "B"
Nout = Xx + 2
Rst!nouv_categ = Categ
Rst!nouv_not = Nout
ElseIf Omr < 25 Then
Categ = "C"
Nout = Xx + 1
Rst!nouv_categ = Categ
Rst!nouv_not = Nout
End If
Rst.Update
Rst.MoveNext
Loop
Rst.Close
Set Rst = Nothing
MsgBox "Update was completed successfully." & vbCrLf & "Thank you"
End Sub

ويتم استدعاء الإجراء من خلال حدث ما أو زر أمر كالتالي:

Private Sub Cmd0_Click()
On Error GoTo Err_Cmd0_Click

   Call Gharram

Exit_Cmd0_Click:
	Exit Sub

Err_Cmd0_Click:
	MsgBox Err.Description
	Resume Exit_Cmd0_Click

End Sub

وهذا مرفق يوضح ذلك

bd2.rar

شكرا جزيلا للأستاذين القديرين mas123 و غرام العقول