طاهر اوفيسنا

شكرا استاذ على الإهتمام الكود به مشكلة لاحظ الفيديو 2024-12-06_13-53-56.rar 20241205.rar

ممكن اضافة الدالة هذه وعند ظهور Msgbox لا يحدث سجل منح ' استدعاء الدالة للتحقق من منحة الحج f = DCount("year(Menha_Date)", "Mena7", "EmployeeID=" & Me.EmployeeID) If f >= 1 And Me.Menha_ID = "11" Then MsgBox " هذا المنحرط (ة) استفاد بمنحة الحج لسنة :" & "" & years, vbExclamation, "تنبيه" Me.Undo End If الى الدالة Private Sub CmdMenha_AfterUpdate() Dim result As String Dim userResponse As VbMsgBoxResult Dim emp As Integer emp = EmployeeID ' استدعاء الدالة للتحقق من الانخراط result = CheckInkhirat(emp) ' عرض النتيجة في رسالة userResponse = MsgBox(result, vbOKOnly + vbInformation, "نتيجة التحقق") ' التحقق من استحقاق الامتياز قبل المتابعة If result Like "*كاملا*" Then ' طلب تأكيد تثبيت المنحة If MsgBox("هل تريد تثبيت تاريخ المنحة؟", vbYesNo + vbQuestion, "تأكيد") = vbYes Then ' إذا وافق المستخدم، يتم تثبيت التاريخ وإكمال العملية Me.AwardMonth = DATE Me.Menha_Value = CmdMenha.Column(2) Me.Obsérvation = Nom_Menha Me.annee = year(Me.AwardMonth) Else ' إذا رفض المستخدم، يتم التراجع عن أي تغييرات Me.Undo End If Else ' إذا لم يتم استيفاء شروط الانخراط، لا يمكن تثبيت المنحة MsgBox "لا يمكنك تثبيت المنحة لأن شروط الانخراط غير مستوفاة.", vbExclamation, "تنبيه" Me.Undo End If End Sub علما ان المنحة رقم 11 تعني الحج وتعطى مرة واحدة فقط

وهو كذلك وجدت الدالة مكررة شكرا لك استاذي على يد المساعدة حفظك الله ورعاك

الكوذ وقع به خلل عند الاستدعاء استاذ

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

شكرا استاذي العزيز وهو كذلك جربت الى غاية شهر 1 و 2 من السنة الجديدة الكود يستجيب للإمتياز اما شهر 3 فلا يستجيب وهو الاصح الان ممكن إضافة "MsgBox" يعلمني ان العامل بإمكانه الاستفادة لأنه منخرط خلال السنة الماضية يظهر خلال شهر 1 و 2 فقط من السنة الجديدة

استاذ إنتابتني فكرة حول هذه الدالة GetOther لأنها تفي بالغرض المطلوب في الدالة القديمة راجعها او حاول ادماجها مع الدالة الجديدة Public Function GetOther(ByRef ID As Integer) As Boolean On Error GoTo err_GetOther Dim rst As DAO.Recordset Dim MySQL As String Dim sadad As Boolean Dim anne As Integer If Month(Date) < 3 Then anne = Year(Date) - 1 Else anne = Year(Date) End If sadad = IIf(DLookup("sadad", "tbl_Loans", "EmployeeID =" & ID & " And Year(tbl_Loans.Auto_Date) =" & anne) = True, True, False) If sadad = False Then Choix = 0: Exit Function Choix = 1 If Month(Date) <= 3 Then: GetOther = True: Exit Function MySQL = "" MySQL = "SELECT tbl_Loans.Auto_ID, tbl_Loans.EmployeeID, tbl_Loans.Auto_Date, tbl_Loans.Loan_Type, tbl_Loans.Remarks, Year(tbl_Loans.Auto_Date) AS Dats" MySQL = MySQL & " FROM tbl_Loans" MySQL = MySQL & " WHERE tbl_Loans.Loan_Type ='Inkhirat'" MySQL = MySQL & " And tbl_Loans.EmployeeID =" & ID MySQL = MySQL & " And Year(tbl_Loans.Auto_Date) =" & Year(Date) MySQL = MySQL & " ORDER BY tbl_Loans.Auto_Date" 'Debug.Print MySQL Set rst = CurrentDb.OpenRecordset(MySQL) rst.MoveLast: rst.MoveFirst Rec = rst.RecordCount If Month(Date) = 7 Then tot = DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " And Year(Auto_Date) = " & Year(Date)) = 3000 If Not tot Then GetOther = False: Exit Function End If If Rec = 0 Then GetOther = False Else GetOther = True End If 'Debug.Print Adding rst.Close: Set rst = Nothing Exit Function err_GetOther: If Err.Number = 3021 Then 'Or Err.Number = 3061 Then 'ignor, No Record Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End

التعديل لم يفي بالغرض انطر الفيديو 2025-01-01_06-47-01.rar

استاذ الملف الي بحوزتك غير سنة الجهاز الى 2025 والشهر الى 01 وحاول منح امتياز للعامل كريمو 1 الذي تم قبول امتياز له خلال 2024 بحكم انه منخرط في 2024 اما دخول سنة 2025 فهو غير منخرط الى غاية انخراطه في شهر 3 هل الكود يعطيه الحق في الامتياز خلال شهر 1 و 2 و 3 من 2025 المطلوب تعديل الى غاية شهر 3 من كل سنة جديدة امل اني وفقت في توضيح المطلوب استاذي الكريم

شكر استاذي العزيز Barna على المساعدة الله يجعلها في ميزان حسناتك كما نتمنى من إدارة المنتدي تصحيح العنوان لانه به اخطاء

شكرا استاذ وهو كذلك ولكن الشرط Loan_ID = 0 لم تقم بإضافته للدالة totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 0) علما ان الجدول tbl_Loans فيه الانخراطات والقروض وغيرها يلزم الشرط

والفيديو الثاني يبين دحول الكود الى تثبيت المنحة 2024-11-28_15-46-17.rar

انظر الفيديو 2024-11-28_15-41-00.rar

الرسالة الثانية لم تظهر لي استاذ عند التعديل

01- قبل التعديل على الملف يجب مراعاة هذا الشرظ totalPaid = Nz(DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " AND Year(Auto_Date) = " & yearNow), 0) كيف يتم زيادة هذا الشرط Loan_ID = 0 للدالة totalPaid علما ان الفلترة 0 يخص الانخراط فقط 02- كريمو 1 منخرط جرب في كريمو 2 او 3

نفس المشكلة اليك المرفق ركز مع الصورة المرفقة 20241128.rar

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

شكرا استاذي العزيز Barna على سرعة الرد لاحط كيفية تم استدعاء الكود Private Sub CmdMenha_AfterUpdate() Dim result As String result = CheckInkhirat(EmployeeID) MsgBox result If MsgBox("هل تريد تثبيت تاريخ المنحة", vbYesNo) = vbYes Then Me.AwardMonth = Date Menha_Value = CmdMenha.Column(2) Me.Obsérvation = Nom_Menha Me.annee = Year(AwardMonth) Else Me.Undo End If End Sub وصحيح يظهر MsgBox يالتنيبه ولكن عنذ الضغط على زر موافق يقوم باعطائه الامتياز فكيف يتم التعديل

السلام عليكم اساتذة نريد من يساعدني في انشاء وحدة نمطية او التعديل على الدالة المرفقة مهمتها ان تظهر ميساج في حال استدعائها بالفورم بشروط 1- الانخراط يكون اما بدفع القيمة كاملة مرة واحدة ( 3000 دج ) حلال السنة اي من شهر 01 الى شهر 08 2- وإما المبلغ ( 3000 دج ) يكون على ذفعتين اي (1500 دج) خلال شهر 3 و ( 1500 دج) خلال شهر 7 3- في حالة تم التسديد بستفيد المنحرط من كل المزايا 4- في حالة عدم التسديد لا يستفيد المعني بأي امتياز وهنا يظهر المبساج "عزيزي العامل لا يمكنك الإستفادة من الإمتيازات لأنك لم تدفع مبلغ الإنخراط " وشكرا علما لديا هذه الدالة ولكن لاتؤدي وظيفتها على مايرام Public Function GetInkhirat(ByRef ID As Integer) As Integer On Error GoTo err_GetInkhirat Dim rst As DAO.Recordset Dim MySQL As String MySQL = "" MySQL = "SELECT DISTINCT(annee) FROM tbl_Loans " MySQL = MySQL & "WHERE EmployeeID = " & ID & "And Loan_ID = 0 " MySQL = MySQL & "GROUP BY annee" Set rst = CurrentDb.OpenRecordset(MySQL) rst.MoveLast: rst.MoveFirst Rec = rst.RecordCount GetInkhirat = Rec rst.Close: Set rst = Nothing Exit Function err_GetInkhirat: If Err.Number = 3021 Then 'Or Err.Number = 3061 Then 'ignor, No Record Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Public Function GetOther(ByRef ID As Integer) As Boolean On Error GoTo err_GetOther Dim rst As DAO.Recordset Dim MySQL As String Dim sadad As Boolean Dim anne As Integer If Month(Date) < 3 Then anne = Year(Date) - 1 Else anne = Year(Date) End If sadad = IIf(DLookup("sadad", "tbl_Loans", "EmployeeID =" & ID & " And Year(tbl_Loans.Auto_Date) =" & anne) = True, True, False) If sadad = False Then Choix = 0: Exit Function Choix = 1 If Month(Date) <= 3 Then: GetOther = True: Exit Function MySQL = "" MySQL = "SELECT tbl_Loans.Auto_ID, tbl_Loans.EmployeeID, tbl_Loans.Auto_Date, tbl_Loans.Loan_Type, tbl_Loans.Remarks, Year(tbl_Loans.Auto_Date) AS Dats" MySQL = MySQL & " FROM tbl_Loans" MySQL = MySQL & " WHERE tbl_Loans.Loan_Type ='Inkhirat'" MySQL = MySQL & " And tbl_Loans.EmployeeID =" & ID MySQL = MySQL & " And Year(tbl_Loans.Auto_Date) =" & Year(Date) MySQL = MySQL & " ORDER BY tbl_Loans.Auto_Date" 'Debug.Print MySQL Set rst = CurrentDb.OpenRecordset(MySQL) rst.MoveLast: rst.MoveFirst Rec = rst.RecordCount If Month(Date) = 7 Then tot = DSum("Payment_Made", "tbl_Loans", "EmployeeID = " & ID & " And Year(Auto_Date) = " & Year(Date)) = 3000 If Not tot Then GetOther = False: Exit Function End If If Rec = 0 Then GetOther = False Else GetOther = True End If 'Debug.Print Adding rst.Close: Set rst = Nothing Exit Function err_GetOther: If Err.Number = 3021 Then 'Or Err.Number = 3061 Then 'ignor, No Record Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function

شكرا استاذي على المساعدة ربي يجعلها في ميزان حسناتك

وهو كذلك استاذي العزيز ربي يبارك فيك والان لاحظ عند نقل المبلغ تكون فاصلة العشرات 00 الاصح : 2,180,033.40 - 808,149.33 الخطا : 2,180,033.00 - 808,149.00

للأسف لم يفي بالغرض المطلوب استاذي يعني لم يتم بالتصفية حسب التواريخ

اتعبتك معي استاذي العزيز الم تلاحظ ان البحث كان ينفذ عادي قبل الكود الاخير لجملة الـ strSQL 'FormatDate d1 = Format(Me.Date_First, "MM/dd/yyyy") d2 = Format(Me.Date_End, "MM/dd/yyyy")

انظر الصورة فلربما يتضح لك شيء والمعلومات الي عليها مربع احمر من جدول Bdgi هنا عادي ولكن يقوم بالتصفية حسب السنة strSQL = "INSERT INTO kanory ( a, b, c, d) SELECT Bdgi.Obsérvation, Bdgi.PDG_Pr, ""02- المداخيل ( الموارد)"" AS Expr1, ""1"" AS Expr2 FROM Bdgi WHERE (((Bdgi.année)= sn));" اما هنا وقع المشكل في التصفية بالتاريخ strSQL = "INSERT INTO kanory ( a, b, c, d) SELECT Bdgi.Obsérvation, Bdgi.PDG_Pr, ""02- المداخيل ( الموارد)"" AS Expr1, ""1"" AS Expr2 FROM Bdgi WHERE Bdgi.PDG_Date Between #" & d1 & "# And #" & d2 & "#;" DoCmd.SetWarnings (0) DoCmd.RunSQL strSQL DoCmd.SetWarnings (0) 20241030.mdb