Barna

كما ذكر اخي @Foksh صورة او ورقة اكسل وتكتب كل العناوين فيها وجعلها بدل مربعات النص او ورقة وورد

يبدو المشكلة لديك في الاستعلام Qry_rptD1 مكتوب بطريقة معقدة

استبدل نص الرسالة بهذا MsgBox "تم توزيع الإقتطاعات بنجاح" & vbCrLf & _ "مجموع اقتطاعات القروض: " & Format(TotalLoanDeductions, "#,##0.00") & " دج" & vbCrLf & _ "مجموع اقتطاعات الانخراط: " & Format(TotalSubscriptionDeductions, "#,##0.00") & " دج" & vbCrLf & _ "المجموع الكلي للاقتطاعات: " & Format(TotalDeductions, "#,##0.00") & " دج" & vbCrLf & _ "الباقي الكلي: " & Format(Remaining1, "#,##0.00") & " دج", _ vbInformation, "إقتطاعات شهر " & FrenchMonth(Month(Now())) & " " & Year(Now()) جرب واعلمنا بالنتيجة

ممكن تلصق الكود كاملا هنا .. حتى نعرف ايش صار

هذه فكرة فقط ... انت من يحدد ماذا تريد وغير ملزم لك . حسب برنامجك ويمكن الغائها نهائيا

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

طيب جرب المرفق التالي بعد مسح الاقتطاعات BAR_2.mdb

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

طيب جرب المرفق بعد مسح بيانات الانخراطات والقروض ............. BAR_2.mdb

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

جرب المرفق التالي BAR_1.mdb قم بمسح الاقتطاعات السابقة

هذا الكود المطلوب نسخه مكان كود الشرط الثاني لديك

انت لم تنسخ وتلصق الكود كاملا ................

المشكلة في التحقق كان الكود يتحقق من كل سجلات المنخرط سواءا كانت مدفوعات او انخراط ' التحقق من المدفوعات السابقة مع تصفية `wada3 = "تم الإنخراط"` If Month(Now()) = 3 Then PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 1, 1) & "# AND #" & DateSerial(SelectedYear, 2, 28) & "# AND [wada3]='تم الإنخراط'"), 0) Else PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 4, 1) & "# AND #" & DateSerial(SelectedYear, 6, 30) & "# AND [wada3]='تم الإنخراط'"), 0) End If

اهلا بك ...... جرب هذا .... If Month(Now()) = 3 Or Month(Now()) = 7 Then Dim db As DAO.Database Dim rstE As DAO.Recordset, rst As DAO.Recordset Dim myCriteria As String, TheSum As Double, PaymentCheck As Variant Dim SelectedYear As Integer Set db = CurrentDb ' استخراج السنة من التكست بوكس SelectedYear = Year(Now()) ' تحديد معايير الموظفين myCriteria = "[detach] IN ('موظف', 'عامل متعاقد توقيت كامل', 'عامل متعاقد توقيت جزئي', 'حارس متعاقد توقيت جزئي', 'عون نظافه وتطهير')" ' فتح سجل الموظفين المطابقين للمعايير Set rstE = db.OpenRecordset("SELECT * FROM Employee WHERE " & myCriteria, dbOpenDynaset) If Not rstE.EOF Then rstE.MoveFirst Do Until rstE.EOF ' التحقق من المدفوعات السابقة مع تصفية `wada3 = "تم الإنخراط"` If Month(Now()) = 3 Then PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 1, 1) & "# AND #" & DateSerial(SelectedYear, 2, 28) & "# AND [wada3]='تم الإنخراط'"), 0) Else PaymentCheck = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " AND [Payment_Month] BETWEEN #" & DateSerial(SelectedYear, 4, 1) & "# AND #" & DateSerial(SelectedYear, 6, 30) & "# AND [wada3]='تم الإنخراط'"), 0) End If ' إذا كان الموظف قد دفع بالفعل 3000 أو أكثر، انتقل إلى الموظف التالي If PaymentCheck >= 3000 Then GoTo NextEmployee ' فتح سجل القروض وإضافة اقتطاع جديد إذا لم يكن موجودًا Set rst = db.OpenRecordset("tbl_Loans", dbOpenDynaset) rst.FindFirst "[Loan_Type]='Inkhirat' AND [EmployeeID]=" & rstE!EmployeeID & " AND [Payment_Month]=#" & Format(CDate(Me.txtMonth), "mm/dd/yyyy") & "#" If rst.NoMatch Then rst.AddNew rst!EmployeeID = rstE!EmployeeID rst!Loan_ID = 0 'rst!Payment_Month = DateSerial(Year(CDate(Me.txtMonth)), Month(CDate(Me.txtMonth)), 1) 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(CDate(Me.txtMonth)) & "/" & Month(CDate(Me.txtMonth)) rst!annee = SelectedYear rst!sadad = rst!Payment_Made rst!wada3 = IIf(rst!sadad > 0, "تم الإنخراط", "لم يتم الإنخراط") rst.Update TheSum = TheSum + Nz(rst!Payment_Made, 0) End If rst.Close NextEmployee: rstE.MoveNext Loop rstE.Close: Set rstE = Nothing db.Close: Set db = Nothing ' تنسيق وعرض المجموع TheSum = Format(TheSum, "#,##0.00") MsgBox "تم توزيع الإقتطاعات" & vbCrLf & vbCrLf & "مجموع الإقتطاعات = " & TheSum, , "إقتطاعات شهر " & FrenchMonth(Month(CDate(Me.txtDate))) & SelectedYear End If

جرب هذا Function record(Criteria As String) Dim rs As DAO.Recordset Dim db As DAO.Database Dim condition As String ' قم بتعيين قاعدة البيانات الحالية Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM customers") ' تحديد الشرط condition = "City = '" & Criteria & "'" rs.FindFirst condition Do While Not rs.NoMatch ' إضافة العنصر إلى القائمة List1.AddItem rs!FirstName ' ابحث عن العنصر التالي rs.FindNext condition Loop ' إغلاق السجل rs.Close Set rs = Nothing Set db = Nothing End Function Private Sub Command0_Click() Dim City As String ' تعيين القيمة للمدينة City = "aa" ' استدعاء الدالة record City End Sub

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

نعم صحيح

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

طيب الحمد لله .... جرب كدة المشكلة السابقة واعلمنا بالنتيجة BAR_A.mdb

عند توفر جهاز حاسب .. انظر فيها طيب جرب بقية الاحتمالات ... واعلمنا بها النظر بها جميعا ان شاء الله تعالى

لم افهم عليك ... لاني اخاطبك بالهاتف

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

طيب لاحظ الشرح التالي ::::::::::::::::::::::::::::: اولا:: الجدول tbl_MenhaRules يجب كتابة اسم المنحة ورقم المنحة ونوع المنحة كما هو موجود بالجداول الموجودة لديك دون تغيير ( اوكد دون تغير لا في الرقم ولا في الاسم ولا في نوع المنحة) كما في الصورة ثانيا:::: المنح التي يكتب في هذا الجدول فقط التى عليها شروط ( 1 تعني سنه - 2 تعني سنتان وهكذا - اما التي تصرف مرة واحدة فسجلها 100 ) ثالثا::: بقية المنح لا تسجل ابدا في هذا الجدول ( يعني في النهاية سوف يون لديك عدد سجلات بسيطة في هذا الجدول الجديد tbl_MenhaRules ) رابعا :::: طبق على المثال المرفق واعلمنا بالنتيجة BAR_A.mdb

هل انت بصدد تعديل شامل على البرنامج ام ماذا؟؟ لاننا لا نريد تعديل الاكواد لكثرتها فقط نريد انشاء جدول واحد جديد فقط اقوم لإنشاء الجدول واعدل في المرفق السابق .... انتظرني