ناقل

وعليكم السلام ورحمة الله وبركاته عن نفسي ... حاولت افهم آلية عمل برنامجك وعجزت فعل ذلك ... لانه من الصعب وضع اكواد وانت لم تفهم الآلية ... هل عند الاقتطاع يتم ادراج سجل جديد ام يتم تحديث نفس السجلات وايضا دفع الانخراط ... ماذا تريد انت من الكود أن يفعل ،???? لذلك توقفت عن الإجابة ...

جميل جدا ..... بارك الله فيك ... ماشاء الله تبارك الله دائما مبدع .... انا الحقيقة انشغل في برنامج خاص بي .. لكنك سبقت واجدت المطلوب

ارنا محاولاتك ... وبعدها نحاول معك

جرب .............. Private Sub cmd_Pay_installments_Click() On Error GoTo err_cmd_Pay_installments_Click ' .......................... الشطر الاول اقتطاع القروض Dim rst As DAO.Recordset 'Cridi and Elec Payments Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans Where [Payment_Month]=CDATE('" & Me.txtMonth & "')") rst.MoveLast: rst.MoveFirst Rc = rst.RecordCount a1 = 0 'just a flag a2 = 0 'just a flag If Rc = 0 Then MsgBox " لا توجد إقتطاعات لشهر " & Format(Me.txtMonth, "mmmm") & " " & Year(Me.txtMonth), vbInformation Exit Sub End If If Len(rst!Payment_Made & "") = 0 And Not IsNull(rst!Loan_Made) Then Select Case MsgBox("هل تريد أن يتم توزيع الإقتطاعات لشهر " & Me.txtMonth, vbYesNo + vbQuestion + vbDefaultButton1) Case vbYes For i = 1 To Rc rst.Edit If rst!Nr >= 6 Then rst!Payment_Made = 0# Else If rst!Loan_Type = "Cridi" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If If rst!Loan_Type = "Elec" Then rst!Payment_Made = rst!Loan_Made rst!sadad = rst!Loan_Made rst!Loan_Remise = 0 End If End If If rst!sadad.Value = True Then rst!wada3 = "تم التسديد" Else rst!wada3 = "لم يتم التسديد" End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update rst.MoveNext Next i ' .......................... الشطر الثاني اقتطاع الانخراط 'Other loans for March (3) and July (7) If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim rstE As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Loans") myCriteria = "([detach]='موظف'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت كامل'" myCriteria = myCriteria & " Or [detach]='عامل متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='حارس متعاقد توقيت جزئي'" myCriteria = myCriteria & " Or [detach]='عون نظافه وتطهير')" Set rstE = CurrentDb.OpenRecordset("Select * From Employee Where " & myCriteria) rstE.MoveLast: rstE.MoveFirst Rc = rstE.RecordCount For i = 1 To Rc ' استثناء الموظف الذي دفع 3000 If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & " And [Payment_Made]=3000 And [Payment_Month]=#" & Me.txtMonth & "#"), 0) <> 3000 Then rst.FindFirst "[Loan_Type]='Inkhirat' And [EmployeeID]=" & rstE!EmployeeID & " And [Payment_Month]=#" & Me.txtMonth & "#" If rst.NoMatch Then rst.AddNew a2 = 1 rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 rst!Payment_Month = DateSerial(Year(Me.txtMonth), Month(Me.txtMonth), 1) rst!Payment_Made = DLookup("Other_Value", "TblOther", "ID=1") rst!Loan_Type = "Inkhirat" rst!Nr = GetNumDetach(rst!EmployeeID) rst!Remarks = "إقتطاع من الراتب لإنخراط شهر " & Year(Me.txtMonth) & "/" & Month(Me.txtMonth) rst!annee = Year(Date) If rst!Loan_Type = "Inkhirat" Then rst!sadad = rst!Payment_Made If rst!sadad.Value = True Then rst!wada3 = "تم الإنخراط" Else rst!wada3 = "لم يتم الإنخراط" End If End If TheSum = TheSum + Nz(rst!Payment_Made, 0) rst.Update End If rstE.MoveNext Next i rstE.Close: Set rstE = Nothing End If TheSum = Format(TheSum, "#,##0.00") MsgBox " " & "تم توزيع الإقتطاعات" & vbLf & vbLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر" & FrenchMonth(Month(Date)) & Year(Date) I_am_Done: Case vbNo MsgBox "لم يتم توزيع الإقتطاعات" End Select rst.Close: Set rst = Nothing End If Exit Sub err_cmd_Pay_installments_Click: If Err.Number = 3021 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub

انا فتحت النموذج طيب بعدين .... كيف يعمل برنامجك .... لكي نرى النتيجة ؟؟؟؟؟؟؟؟؟؟؟؟ في حال محاولة التشغيل يتوقف على Abou_Taha مما هذه ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

انت بحاجة الى نظام صلاحيات مجموعات ........ انظر المثال

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

جرب المرفق .... Test (30).accdb

تفضل جرب المرفق Test (30).accdb

هذا التصور العام لها بارك الله في .... يتبقى الترجمة لاكواد ....

جرب المرفق .... Test (29).accdb

يعني انت تريد بعد العمليات السابقة حذف السعر المدخل سابقا وتريد نقل السعر الموجود في التوزيع ليحل محل السعر السابق ... انظر الصورة

اولا الشكر لك على هذه التحفة الفنية ..... ثانيا ان سمحت لي باقتباس هذه الساعة ... اريد تحويرها لارقام طلب الدور للعملاء والمطاعم وغيرها ان سمحت لي ...

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

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