Foksh

قد استعجبت من الملف والنتائج المتفاوتة بين أكثر من مستخدم .. ولذلك ، جرب هذا التعديل التالي :- Private Sub cmd_Do_Changes_Click() On Error GoTo Err_Handler Dim rst As DAO.Recordset Dim db As DAO.Database Dim Dat As Date Dim Remarks As String Dim i As Integer Dim Loan_Type As String Dim MySQL As String Dim NewPaymentMonth As Date Dim ExistingRecord As Boolean Dim DiscountEndDate As Date Dim ObsText As String Dim RecID As Long Me.Month_From = DateSerial(Year(Me.Month_From), Month(Me.Month_From), 1) If Me.Month_From < Me.DiscountStartDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أصغر من شهر بداية الإقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى", vbExclamation + vbMsgBoxRight, "" Exit Sub ElseIf Me.Month_From > Me.DiscountEndDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أكبر من شهر نهاية آخر إقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى", vbExclamation + vbMsgBoxRight, "" Exit Sub End If If Me.OpenArgs = "frmCridi" Then Loan_Type = "Cridi" Else Loan_Type = "Elec" End If MySQL = "SELECT * FROM tbl_Loans WHERE Loan_ID = " & Me.Loan_ID & " AND Loan_Type='" & Loan_Type & "'" Set db = CurrentDb Set rst = db.OpenRecordset(MySQL, dbOpenDynaset) For i = 0 To Me.Number_Of_Months - 1 Dat = DateAdd("m", i, Me.Month_From) NewPaymentMonth = DateAdd("m", i + 1, Me.DiscountEndDate) ExistingRecord = False If Not rst.BOF And Not rst.EOF Then rst.MoveFirst rst.FindFirst "[Payment_Month]=#" & Dat & "#" If Not rst.NoMatch Then ExistingRecord = True End If End If If ExistingRecord Then Remarks = Nz(rst!Remarks, "") rst.Edit rst!Loan_Made = 0 rst!Remarks = Remarks & " | تأجيل الإقتطاع إلى " & NewPaymentMonth rst!wada3 = "تم التأجيل" rst.Update End If rst.AddNew rst!EmployeeID = Me.EmployeeID rst!Loan_ID = Me.Loan_ID rst!Auto_Date = Me.AwardMonth rst!Payment_Month = NewPaymentMonth rst!Loan_Made = Me.DiscountPerMonth rst!Loan_Type = Loan_Type rst!Remarks = Remarks rst!annee = Year(Date) rst.Update Next i DiscountEndDate = DateAdd("m", Me.Number_Of_Months, Forms!frmCridi!Frm_sub!DiscountEndDate) Forms!frmCridi!Frm_sub!DiscountEndDate = DiscountEndDate ObsText = Nz(Forms!frmCridi!Frm_sub!Obsérvation, "") & " | تأجيل الإقتطاع لمدة " & Me.Number_Of_Months & " أشهر" Forms!frmCridi!Frm_sub!Obsérvation = ObsText RecID = Nz(Forms!frmCridi!Frm_sub!ID, 0) Forms!frmCridi!Frm_sub.Form.Requery Set rst = Forms!frmCridi!Frm_sub.Form.RecordsetClone If RecID <> 0 Then rst.FindFirst "[ID]=" & RecID If Not rst.NoMatch Then Forms!frmCridi!Frm_sub.Form.Bookmark = rst.Bookmark End If End If MsgBox "تم تأجيل الإقتطاع لمدة " & Me.Number_Of_Months & " أشهر بنجاح", vbInformation + vbMsgBoxRight, "" rst.Close: Set rst = Nothing Set db = Nothing DoCmd.Close Exit_Sub: Exit Sub Err_Handler: MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, "" Resume Exit_Sub End Sub جربه وأخبرني بالنتيجة للمتابعة 😇 . تأجيل الاقتطاع.zip ==================== وأيضاً قد توجهت الى حل وطريق آخر مختلف نوعاً ما .. جرب الكود التالي أيضاً بدون مرفق حتى لا تتوه الأفكار منك كثيراً :- Private Sub cmd_Do_Changes_Click() On Error GoTo Err_Handler Dim rst As DAO.Recordset Dim db As DAO.Database Dim Dat As Date Dim Remarks As String Dim i As Integer Dim Loan_Type As String Dim MySQL As String Dim NewPaymentMonth As Date Dim ExistingRecord As Boolean Dim DiscountEndDate As Date Dim ObsText As String Dim RecID As Long Me.Month_From = DateSerial(Year(Me.Month_From), Month(Me.Month_From), 1) If Me.Month_From < Me.DiscountStartDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أصغر من شهر بداية الإقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى", vbExclamation + vbMsgBoxRight, "" Exit Sub ElseIf Me.Month_From > Me.DiscountEndDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أكبر من شهر نهاية آخر إقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى", vbExclamation + vbMsgBoxRight, "" Exit Sub End If If Me.OpenArgs = "frmCridi" Then Loan_Type = "Cridi" Else Loan_Type = "Elec" End If MySQL = "SELECT * FROM tbl_Loans WHERE Loan_ID = " & Me.Loan_ID & " AND Loan_Type='" & Loan_Type & "'" Set db = CurrentDb Set rst = db.OpenRecordset(MySQL, dbOpenDynaset) For i = 0 To Me.Number_Of_Months - 1 Dat = DateAdd("m", i, Me.Month_From) NewPaymentMonth = DateAdd("m", i + 1, Me.DiscountEndDate) ExistingRecord = False If Not rst.BOF And Not rst.EOF Then rst.MoveFirst rst.FindFirst "[Payment_Month]=#" & Dat & "#" If Not rst.NoMatch Then ExistingRecord = True End If End If If ExistingRecord Then Remarks = Nz(rst!Remarks, "") rst.Edit rst!Loan_Made = 0 rst!Remarks = Remarks & " | تأجيل الإقتطاع إلى " & NewPaymentMonth rst!wada3 = "تم التأجيل" rst.Update End If rst.AddNew rst!EmployeeID = Me.EmployeeID rst!Loan_ID = Me.Loan_ID rst!Auto_Date = Me.AwardMonth rst!Payment_Month = NewPaymentMonth rst!Loan_Made = Me.DiscountPerMonth rst!Loan_Type = Loan_Type rst!Remarks = Remarks rst!annee = Year(Date) rst.Update Next i DiscountEndDate = DateAdd("m", Me.Number_Of_Months, Forms!frmCridi!Frm_sub!DiscountEndDate) Forms!frmCridi!Frm_sub!DiscountEndDate = DiscountEndDate ObsText = Nz(Forms!frmCridi!Frm_sub!Obsérvation, "") & " | تأجيل الإقتطاع لمدة " & Me.Number_Of_Months & " أشهر" Forms!frmCridi!Frm_sub!Obsérvation = ObsText RecID = Nz(Forms!frmCridi!Frm_sub!ID, 0) Forms!frmCridi!Frm_sub.Form.Requery Set rst = Forms!frmCridi!Frm_sub.Form.RecordsetClone If RecID <> 0 Then rst.FindFirst "[ID]=" & RecID If Not rst.NoMatch Then Forms!frmCridi!Frm_sub.Form.Bookmark = rst.Bookmark End If End If MsgBox "تم تأجيل الإقتطاع لمدة " & Me.Number_Of_Months & " أشهر بنجاح", vbInformation + vbMsgBoxRight, "" rst.Close: Set rst = Nothing Set db = Nothing DoCmd.Close Exit_Sub: Exit Sub Err_Handler: MsgBox "حدث خطأ", vbCritical + vbMsgBoxRight, "" Resume Exit_Sub End Sub

قم أولا بالغاء أفضل إجابة يا صديقي ، حتى تجد حل للمشكلة التي لا اعلم ما هو سببها في جهازك .. ثانياً الصور التي ارفقتها جميعها من جهازين مختلفين و 3 نسخ أوفيس مختلفة ( 2016 ، 2010 و 2019 ) أضف الى ذلك ، الحدث الذي تستخدمه عند فتح النموذج في الصورة المرفقة التالية ، قد يكون أحد أسباب الخلل في البيانات التي يتم عرضها فيه

تأجيل الاقتطاع 3 أشهر.zip

💯/💯 وطبعاً إضافتك جعلت الفكرة شاملة لجميع أنواع البيانات

باعتقادي ودون الحاجة الى التوسعات في الإحتمالات ، المشكلة تكمن في السطر التالي :- Dim DB As Database, rs As Recordset بأن يتم التعديل كالتالي :- Dim DB As DAO.Database, rs As DAO.Recordset هذا من وجهة نظري المتواضعة فقط لا غير 😁 . وكل عام وأنتم بخير جميعاً

بعد هذه الصورة لا اعتقد انه يوجد لدي ما أزيد به .. تم التنفيذ والتجربة على نسخة أوفيس 2010 !! رغم انها على إصدار 2019 أيضاً كانت النتيجة كما في الصور التي ارفقتها سابقاً .. ولكن قد تكون المشكلة كما خطر لي بأن تكون في تنسيق التاريخ وباختلاف نمط التاريخ .. على العموم جرب المرفق وأخبرنا بالنتيجة 👀 . تأجيل الاقتطاع.zip

أخي @طاهر اوفيسنا ، أولاً تقبل الله طاعاتكم ، وكل عام وأنتم بخير ,, جرب التعديل التالي بإزالة التنسيق من التاريخ فقط !! Private Sub cmd_Do_Changes_Click() Dim rst As DAO.Recordset Dim Dat As Date Dim Remarks As String Dim i As Integer Me.Month_From = DateSerial(Year(Me.Month_From), Month(Me.Month_From), 1) If Me.Month_From < Me.DiscountStartDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أصغر من شهر بداية الإقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى" Exit Sub ElseIf Me.Month_From > Me.DiscountEndDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أكبر من شهر نهاية أخر إقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى" Exit Sub End If If Me.OpenArgs = "frmCridi" Then MySQL = "Select * From tbl_Loans Where Loan_ID = " & Me.Loan_ID & " And Loan_Type='Cridi'" Loan_Type = "Cridi" r = "" Else MySQL = "Select * From tbl_Loans Where Loan_ID = " & Me.Loan_ID & " And Loan_Type='Elec'" Loan_Type = "Elec" r = "" End If Set rst = CurrentDb.OpenRecordset(MySQL) For i = 0 To Me.Number_Of_Months - 1 Dat = DateAdd("m", i, Me.Month_From) rst.FindFirst "[Payment_Month]=#" & Dat & "#" If Not rst.NoMatch Then Remarks = rst!Remarks rst.Edit rst!Loan_Made = 0 rst!Remarks = Remarks & " | " & "تأجيل الإقتطاع إلى تاريخ " & DateAdd("m", i + 1, Me.DiscountEndDate) rst.Update End If rst.AddNew rst!EmployeeID = Me.EmployeeID rst!Loan_ID = Me.Loan_ID rst!Auto_Date = Me.AwardMonth rst!Payment_Month = DateAdd("m", i + 1, Me.DiscountEndDate) rst!Loan_Made = Me.DiscountPerMonth rst!Loan_Type = Loan_Type rst!Remarks = Remarks rst!annee = Year(Date) rst.Update Next i rst.Close: Set rst = Nothing Forms!frmCridi!Frm_sub!DiscountEndDate = DateAdd("m", Me.Number_Of_Months, Forms!frmCridi!Frm_sub!DiscountEndDate) Forms!frmCridi!Frm_sub!Obsérvation = Forms!frmCridi!Frm_sub!Obsérvation & " | " & _ "تأجيل الإقتطاع لمدة " & GetMoisName(i) I2 = Forms!frmCridi!Frm_sub!ID Forms!frmCridi!Frm_sub.Form.Requery Set rst = Forms!frmCridi!Frm_sub.Form.RecordsetClone rst.FindFirst "[ID]=" & I2 Forms!frmCridi!Frm_sub.Form.Bookmark = rst.Bookmark MsgBox ("تم تأجيل الإقتطاع لمدة " & GetMoisName(i)) DoCmd.Close End Sub تأجيل الاقتطاع.zip

نرجوا منكم أخي @أبو أحمد الفاضل ، تقييم أفضل إجابة لصاحب الحل ، وليس لردكم الكريم 😇 .

عيدكم مبارك جميعاً ، وتقبل الله منا ومنكم صالح الأعمال والطاعات 🤲🏻.

حسناً ، سأحاول غداً تثبيت نسخة اوفيس 2010 ، وتجربة المرفق على إصدار آخر والعمل على التعديل بناءً عليه .. مع انني لا اعلم ما هو سبب اختلاف النتيجة بين الإصدارين .

نرجو من احد الإخوة والاساتذة الذي يمرون من هنا تجربة المرفق واخبارنا بالنتيجة .. تأجيل الاقتطاع.zip

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

لا اعلم ماذا أقول ، ولكن هذه الصورة أيضاً كفيلة بالإجابة .. اعتقد ان المشكلة لديك في إصدار الآكسيس تم تحميل المرفق من المشاركة نفسها ، والنتيجة أعلاه توضح ما تم تنفيذه . علماً انني استخدم إصدار 2016 - 64 بت

وهذه نتيجة الكود الأصلي في المشاركة الأولى لك ( أساس الموضوع ) :- هل قمت بتحميل المرفق الذي ارفقته لك ؟؟

لا تعليق سوى الصورة

بناءً على ما فهمت من المطلوب ، هو اضافة سجلات = عدد الاشهر التي تم تأجيلها ، بشرط ان يتم تأجيل الدفعة ( القيمة ) الى الاشهر الجديدة ؛ صحيح ؟ جرب ها التعديل !!! Private Sub cmd_Do_Changes_Click() Dim rst As DAO.Recordset Dim Dat As Date Dim Remarks As String Dim i As Integer Me.Month_From = DateSerial(Year(Me.Month_From), Month(Me.Month_From), 1) If Me.Month_From < Me.DiscountStartDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أصغر من شهر بداية الإقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى" Exit Sub ElseIf Me.Month_From > Me.DiscountEndDate Then MsgBox "آسف, شهر التأجيل الذي أدخلته أكبر من شهر نهاية أخر إقتطاع" & vbCrLf & _ "يرجى التصحيح وحاول مرة أخرى" Exit Sub End If If Me.OpenArgs = "frmCridi" Then MySQL = "Select * From tbl_Loans Where Loan_ID = " & Me.Loan_ID & " And Loan_Type='Cridi'" Loan_Type = "Cridi" r = "" Else MySQL = "Select * From tbl_Loans Where Loan_ID = " & Me.Loan_ID & " And Loan_Type='Elec'" Loan_Type = "Elec" r = "" End If Set rst = CurrentDb.OpenRecordset(MySQL) For i = 0 To Me.Number_Of_Months - 1 Dat = Format(DateAdd("m", i, Me.Month_From), "yyyy-mm-dd") rst.FindFirst "[Payment_Month]=#" & Dat & "#" If Not rst.NoMatch Then Remarks = rst!Remarks rst.Edit rst!Loan_Made = 0 rst!Remarks = Remarks & " | " & "تأجيل الإقتطاع إلى تاريخ " & Format(DateAdd("m", i + 1, Me.DiscountEndDate), "DD-MM-YYYY") rst.Update End If rst.AddNew rst!EmployeeID = Me.EmployeeID rst!Loan_ID = Me.Loan_ID rst!Auto_Date = Me.AwardMonth rst!Payment_Month = DateAdd("m", i + 1, Me.DiscountEndDate) rst!Loan_Made = Me.DiscountPerMonth rst!Loan_Type = Loan_Type rst!Remarks = Remarks rst!annee = Year(Date) rst.Update Next i rst.Close: Set rst = Nothing Forms!frmCridi!Frm_sub!DiscountEndDate = DateAdd("m", Me.Number_Of_Months, Forms!frmCridi!Frm_sub!DiscountEndDate) Forms!frmCridi!Frm_sub!Obsérvation = Forms!frmCridi!Frm_sub!Obsérvation & " | " & _ "تأجيل الإقتطاع لمدة " & GetMoisName(i) I2 = Forms!frmCridi!Frm_sub!ID Forms!frmCridi!Frm_sub.Form.Requery Set rst = Forms!frmCridi!Frm_sub.Form.RecordsetClone rst.FindFirst "[ID]=" & I2 Forms!frmCridi!Frm_sub.Form.Bookmark = rst.Bookmark MsgBox ("تم تأجيل الإقتطاع لمدة " & GetMoisName(i)) DoCmd.Close End Sub تأجيل الاقتطاع.zip

دعنا نرى إبداعاتك في هذه الفكرة ، علنا نستفيد من أفكارك 😉

فكرة الكود جميلة ، ولا بأس بها ، سلمت على الفكرة . لي تعقيب واحد على ما أظن من خلال قراءة الكود ... في الجزء التالي :- For Each subFld In fld.SubFolders totalSize = totalSize + GetFolderSize(subFld) Next subFld يتم حجز مساحة في الذاكرة بشكل رهيب جداً ومتكرر بسبب تكرار الإستدعاء = For Each ، وخصوصاً مع المجلدات الكبيرة الحجم !!! وبالتالي سيكون الأداء بطيء جداً عند الإفتراض أن مجلد رئيسي يحتوي 10 مجلدات فرعية - على سبيل المثال - ونريد جلب حجم هذا المجلد ، فأن الكود سيقوم بتخزين الأمر مكرراً 10 مرات في الذاكرة وبالتالي قد ينتج عنه أخطاء إما في جلب البيانات ( حجم المجلد ) أو عدم دقتها ، أو سينتج الخطأ Overflow في نهاية المطاف . كما أنها لا تدعم الإيقاف أو ( ايقاف العملية ) وبالتالي قد تستمر العملية لوقت طويل دون تحكم . وهذه بالنسبة لي الطريقتين التي فهمتهما لاستدعاء الدوال في الكود الذي اقترحته .. 'مثال على مسار مجلد محدد في الكود Sub ExampleGetFolderSize() Dim folderPath As String Dim result As String folderPath = "C:\Intel" result = GetFileInfo( _ inputPath:=folderPath, _ fileType:=ftFolder, _ infoType:=itSizeOnly, _ decimalPlaces:=2 _ ) MsgBox "حجم المجلد: " & result End Sub ' مثال على استخدام مربع حوار لاختيار المجلد Sub ExampleWithFolderPicker() Dim result As String result = GetFileInfo( _ fileType:=ftFolder, _ infoType:=itSizeOnly _ ) If result <> "لم يتم اختيار مجلد" Then MsgBox "حجم المجلد: " & result End If End Sub هذا من وجهة نظري ، ولا أحاول الخروج عن سياق الموضوع .

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

للأسف ، تمت الإجابة التي لا مفر منها مسبقاً في هذه المشاركة .. ولكن يبدو أن صديقنا لم يقتنع بها 😇.

ليس عليك اختيار إجابتي كأفضل إجابة ما لم تكن تريدها بهذا الشكل ، ولكن على العموم شكراً لك وللأسف ليس لدي فكرة كالتي تريدها

ارفق ملف قاعدة البيانات للإطلاع عليه يا صديقي

وهذه مشاركة بطريقة أخرى ، مشاركةً مع معلمي الجليل و والدنا العزيز الأستاذ @ابوخليل .. فكرتين ، الأولى هي بجعل الزر يفتح التقرير بشرطين = DoCmd.OpenReport "qrbook", acViewPreview, , , , Me.fsldrase.Column(1) & ";" & Me.drase.Column(1) وأن نجعل الحدث عند التحميل للتقرير = Dim args As Variant If Not IsNull(Me.OpenArgs) Then args = Split(Me.OpenArgs, ";") Me.Tx_Fasl = args(0) Me.Tx_Yer = args(1) End If والفكرة الثانية كما أشار أستاذي في مشاركته تماماً .. ومرفق زرين كل واحد منهما بطريقة نموذج بحث شامل 1.accdb

وعليكم السلام ورحمة الله تعالى وبركاته.. هذا الخطأ دلالة على ان ملف قاعدة البيانات تالف وغير صالح 🥴 ، طيب هل جربت انك تعمل قاعدة بيانات جديدة وتستورد العناصر والمكونات من القاعدة القديمة التالفة الى الجديدة ؟؟ هي مجرد فكرة طبعاً ، أو انك تفتح قاعدة البيانات باستخدام مفتاح Shift وتحاول تعمل ضغط وإصلاح 🤔 ؟؟ مجرد إحتمالات ما لم ترفق ملف القاعدة.

وعليكم السلام ورحمة الله تعالى وبركاته.. تقدر تستخدام حدث "On Key Down" في النموذج للتحقق مما إذا كان المستخدم قد ضغط على Ctrl + T أو Ctrl + D ثم تغيير خصائص التعديل والحذف بناءً على ذلك . بس طبعاً لازم تتأكد أن خاصية Key Preview في النموذج = Yes 😅 وإلا فلن نستفيد من الكود التالي :- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyT And (Shift And acCtrlMask) <> 0 Then Me.AllowEdits = True MsgBox "تم تفعيل التعديل", vbInformation End If If KeyCode = vbKeyD And (Shift And acCtrlMask) <> 0 Then Me.AllowDeletions = True MsgBox "تم تفعيل الحذف", vbInformation End If End Sub جرب النتيجة النهائية وأخبرنا بها 😇