Foksh

يا اخي والله ما فهمت عليك .. انت تريد اضافتها كسجلات جديدة ؟؟؟؟؟ ام تريد تحديث للسجلات الموجودة ؟؟؟؟؟؟؟؟؟؟؟؟

وعليكم السلام ورحمة الله وبركاته .. اجعل هذا الاستعلام مصدر سجلات النموذج SELECT tbnum.id, tbnum.numx, IIF(tbnum.numx - INT(tbnum.numx) > 0, 'A', 'B') AS resultx FROM tbnum;

يعني اقتربنا من تحقيق الهدف ،،

على حسب ما فهمت , وإن شاء الله يكون قريب من اللي محتاجه .. جرب الاستعلام التالي مصدر سجلات التقرير SELECT tbl_note_administrative.*, IIf([annet]=[Forms]![frm_imprimer_note_administratif]![annet1],1,2) AS RecordType FROM tbl_note_administrative WHERE (((tbl_note_administrative.annet)=[Forms]![frm_imprimer_note_administratif]![annet1] Or (tbl_note_administrative.annet) In (SELECT TOP 3 t.annet FROM tbl_note_administrative t WHERE t.annet < [Forms]![frm_imprimer_note_administratif]![annet1] AND t.situation_special="القيام بالخدمة" AND t.situation_poste_travail="موظف" ORDER BY t.annet DESC )) AND ((tbl_note_administrative.situation_special)="القيام بالخدمة") AND ((tbl_note_administrative.situation_poste_travail)="موظف")) ORDER BY tbl_note_administrative.annet DESC;

لم تظهر عندي المشاكل التي ذكرتها ,, قمت بالتعديل على قيمة بعد الفلترة وتم الحفظ والخروجمن النموذج دون اي رسائل خطأ !!!!!!!!!

بما أن الموضوع حماسي ، وتبارك الله مشاركات وأفكار عظيمة ,, أشارك معكم فكرة على الهامش Private isProcessing As Boolean Private Sub y_n_BeforeUpdate(Cancel As Integer) If isProcessing Then Exit Sub isProcessing = True With Me.RecordsetClone .FindFirst "[y_n]=-1" .Edit !y_n = 0 .Update End With isProcessing = False End Sub

جرب تعديل زر الحفظ كالتالي :- Private Sub cmdSave_Click() On Error GoTo ErrorHandler If WrkSpace Is Nothing Then Set WrkSpace = DBEngine.Workspaces(0) End If If WrkSpace Is Nothing Then MsgBox "حدث خطأ", , "" Exit Sub End If With WrkSpace .CommitTrans Me.Recordset.Requery .BeginTrans End With m_dirty = False Exit Sub ErrorHandler: MsgBox "حدث خطأ", , "" End Sub

عند الحفظ ما الذي سيتم حفظه

زر الفلترة من المفترض حسب ما فهمت هو باختيار الاسم واللقب . تريد الفلترة بالاسم الأول أو الثاني ؟؟؟؟ ولا كلاهما كشرط للفلترة !!!! جرب هذا التعديل BASER.accdb

على العموم ، هل هذا ما تريده ؟؟ control2025.zip

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

ما اصدار الأوفيس عندك ؟؟ 32 ولا 64 ؟؟؟؟ اعتقد أنك لن تقم بإضافة المكتبة التي تم ذكرها ،،

راجع هذا الموضوع ..

انت عارف انه المشكلة في الاستعلام الحالي انه بيعتمد على وظائف مخصصة زي funMyCiretria() funMyCiretria1() funMyCiretria2() علشان تعمل تصفية على السجلات ، وبنفس الوقت انت عايز إضافة فلترة إضافية عند الضغط على الزر Cm2 بحيث يتم جلب السجلات التي يتطابق فيها nom_arabe مع tx3 و prenom_arabe مع tx4 !!!!! الحل هنا وباعتقادي انه يجب أولاً تعديل مصدر السجلات النموذج ليصبح الاستعلام كالتالي :- SELECT tbl_note_administrative.classement_liste, tbl_note_administrative.situation_special, tbl_note_administrative.annet, tbl_note_administrative.nom_arabe, tbl_note_administrative.prenom_arabe, tbl_note_administrative.note_adminstative, tbl_note_administrative.note_directeur, tbl_note_administrative.note_fonctionnaire, tbl_note_administrative.situation_poste_travail, tbl_note_administrative.mm FROM tbl_note_administrative WHERE (((tbl_note_administrative.situation_special)=funMyCiretria1()) AND ((tbl_note_administrative.annet)=funMyCiretria()) AND ((tbl_note_administrative.situation_poste_travail)=funMyCiretria2())) OR (((tbl_note_administrative.nom_arabe)=[Forms]![frm_note_administratif]![tx3]) AND ((tbl_note_administrative.prenom_arabe)=[Forms]![frm_note_administratif]![tx4])) ORDER BY tbl_note_administrative.classement_liste; ثانياً في الزر الخاص بالفلترة = الكود التالي :- Private Sub Cm2_Click() Dim filterCondition As String If Not IsNull(Me.tx3) And Not IsNull(Me.tx4) Then filterCondition = "nom_arabe = '" & Me.tx3 & "' AND prenom_arabe = '" & Me.tx4 & "'" Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub وزر إنهاء الفلترة = الكود التالي :- Private Sub Cm1_Click() Me.tx3 = "" Me.tx4 = "" Me.FilterOn = False Me.Requery End Sub وأما بخصوص الحدث عند التحميل ، فقد تم تعديله بحيث تم استخدام Me.Filter بدلاً من RecordSource Private Sub Form_Load() Dim filterCondition As String filterCondition = "situation_special = '" & funMyCiretria1() & "' " & _ "AND annet = '" & funMyCiretria() & "' " & _ "AND situation_poste_travail = '" & funMyCiretria2() & "'" Me.Filter = filterCondition Me.FilterOn = True Dim WrkSpace As Workspace Set WrkSpace = DBEngine.Workspaces(0) WrkSpace.BeginTrans End Sub هذا من وجهة نظري ، والله أعلم ما لم يكن هناك حل أفضل من أحد الأخوة BASER.accdb

المشكلة يا صديقي انه عند اختيار "All Rooms" من الكومبوبوكس cboRoomNumber ، فإن الشرط في جملة WHERE يصبح : WHERE Transactions.RoomNumber = "All Rooms" ولا اعتقد انه عندك غرفة بهذا الاسم أو الرقم ، صحيح ؟؟ لازم تعديل الشرط بحيث إذا كان قيمة الكومبوبوكس cboRoomNumber تساوي "All Rooms" يتم تجاهل شرط رقم الغرفة، أي يتم عرض جميع الغرف بحيث يصبح الاستعلام هكذا :- SELECT Transactions.RoomNumber, [FirstName] & " " & [LastName] AS Name, [DateIn] & " - " & [DateOut] AS [Date], Transactions.Days, Transactions.AmountPaid, Transactions.DateIn, Transactions.DateOut FROM Transactions INNER JOIN Customers ON Transactions.CustomerID = Customers.CustomerID WHERE (([Forms]![frmRPTRoomHistory]![cboRoomNumber] = 'All Rooms') OR (Transactions.RoomNumber = [Forms]![frmRPTRoomHistory]![cboRoomNumber])) AND ((Transactions.DateIn) Between [Forms]![frmRPTRoomHistory]![dtpCheckIn] And [Forms]![frmRPTRoomHistory]![dtpCheckout]); في المرفق التالي ، تم انشاء استعلام جديد وجعله مصدر سجلات التقرير للتجربة .. Microsoft Access قاعدة بيانات جديد ‫(2)‬.accdb

جرب التعديل التالي :- DoCmd.RunSQL "INSERT INTO tbl_note_administrative (num,nom_arabe,prenom_arabe, date_naissance, lieu_naissance, wilaya_naissance, situation_familiale,nombre_enfant,grade_poste_actuel,sifa,grade,date_effet_grade_actuel,loi_fondamontale,situation_poste_travail,classement_liste, annet, nom_poste, situation_special )" & vbCrLf & _ "SELECT tbl_info_fonctionnaire.num, tbl_info_fonctionnaire.nom_arabe, tbl_info_fonctionnaire.prenom_arabe, tbl_info_fonctionnaire.date_naissance, tbl_info_fonctionnaire.lieu_naissance, tbl_info_fonctionnaire.wilaya_naissance, tbl_info_fonctionnaire.situation_familiale,tbl_info_fonctionnaire.nombre_enfant,tbl_info_fonctionnaire.grade_poste_actuel,tbl_info_fonctionnaire.sifa,tbl_info_fonctionnaire.grade,tbl_info_fonctionnaire.date_effet_grade_actuel,tbl_info_fonctionnaire.loi_fondamontale,tbl_info_fonctionnaire.situation_poste_travail,tbl_info_fonctionnaire.classement_liste, [forms]![frm_AddMonth]![annet1] AS Expr4, tbl_poste_superieur.nom_poste, tbl_situation_juridique_mouv.situation_special " & vbCrLf & _ "FROM (tbl_info_fonctionnaire LEFT JOIN tbl_poste_superieur ON tbl_info_fonctionnaire.num = tbl_poste_superieur.code_fonct) " & vbCrLf & _ "INNER JOIN tbl_situation_juridique_mouv ON tbl_info_fonctionnaire.num = tbl_situation_juridique_mouv.code_fonct " & vbCrLf & _ "WHERE tbl_info_fonctionnaire.situation_poste_travail = 'موظف';"

ما الجديد في مرفقك ؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟ الجزء الذي يظهر فيه الخطأ If Not IsLoaded("frmReports") Then MsgBox "frmReports غير مفتوح!", vbExclamation, "تحذير" Exit Sub End If ناتج عن عدم وجود الدالة IsLoaded التي تتحقق من ان النموذج مفتوح أم لا . وما زال في مرفقك التقرير غير موجود يا صديقي ، فأكيد سيظهر لك أخطاء ( على افتراض أن الملف المرفق هو جزء من مشروعك )

وعليكم السلام ورحمة الله وبركاته .. هل النموذج Room History موجود أولاً في المرفق ؟؟؟؟؟؟؟؟؟؟؟؟؟ هل يوجد أمر في آكسيس Me.Close هل تحاول استخدام أوامر ودوال تخص VB.NET وليست لـ VBA آكسيس !!!!!!!!!!!! طريقة الإتصال بقاعدة البيانات غير صحيحة ( New OleDbConnection ) ، لأن VBA آكسيس على ما اعتقد لا يدعم OleDbConnection بشكل مباشر محاولة لفهم الموضوع بالتصحيح :- ✅ استخدم CreateObject("ADODB.Connection") بدلاً من New OleDbConnection لأن VBA لا يدعم OleDbConnection مباشرة كما أخبرتك سابقاً . ✅ استخدام cboRoomNumber.AddItem لإضافة القيم إلى ComboBox في VBA آكسيس . ✅ تأكد من إغلاق rs و conn بعد الانتهاء لتجنب أي أخطاء أو تسرب للذاكرة . ✅ تعيين ListIndex = 0 فقط إذا كان هناك بيانات في ComboBox . ✅ استخدام Date بدلاً من Today لأن Today غير موجود في VBA ، و Date هو الصحيح . 💡 ملاحظة ، تم التعديل برمجياً ولم يتم تجربة نتيجة التعديل لعدم وجود التقرير .... وخلافه قاعدة بيانات جديد ‫(2)‬.zip

حتى تعرف كيف تحل مثل هذه المشالكل البسيطة .. 1. عليك فهم وترتيب تسلسل الأحداث بشكل بسيط ، فمثلاً :- في زر "موافق" لتسجيل الدخول ، أولاً سيتم فتح النموذج "m" اذا كانت معلومات التسجيل صحيحة ، ثم سنقوم بنقل قيمة اسم المستخدم من مربع النص "UserNm" الى مربع النص "نص11" في النموذج "m" .. إلى الآن هل هذا واضح 2. في نموذج "m" سنجعل القيمة الإفتراضية لمربع النص الخاص بتاريخ اليوم "نص13" = Date وهذا الإختصار يعني تاريخ اليوم . 3. أيضاً في نفس النموذج سنجعل قيمة مربع النص "نص15" = Time وهذا الاختصار يعني الوقت الحالي ( وتستطيع تغيير تنسيق الوقت كما في تريد ) ملفك بعد التعديل نظام الصلاحيات.accdb

مساهمة طيلة منك اخي الكريم.. سؤالي البسيط ، هل يحتاج انترنت ؟؟ لنجرب مثلاً ، عندي مربع تحرير وسرد اسمه "Drive_Nat" ويضم جنسيات مختلفة 😇 .

وعليكم السلام ورحمة الله وبركاته .. السبب أخي انك عند نسخك للكود من زر فتح النموذج 3 لباقي ازرار النماذج ( 4 - 9 ) قمت فقط بتغيير اسم النموذج الذي من المفترض ان يفتحه الزر ، لكنك لم تغير الشرط في الجملة التالية :- Set Q1 = CurrentDb.OpenRecordset("SELECT* FROM Permissions WHERE FrmID = 3 AND UserID = " & CUserID) لاحظ هذا الجزء FrmID = 3 لذا وجب عليك تغييره لرقم النموج الذي سيتم فتحه .. لن ارفق لك الملف على أمل تصحيح المشكلة من طرفك لتعرف اين الخطأ

في الموضوع السابق قم باغلاقة بعبارة "تم ايجاد الحل في مشاركة أخرى" واشر الى هذا الموضوع ، وقم باختيار اجابتك كأفضل إجابة وليس إجابة أخرى .

في هذا التحديث تم إضافة ميزات جديدة وتحكم أكثر مرونة وسلاسة ؛ بحيث :- تم إضافة فكرة إضافة مجلد على جوجل درايف بشكل مباشر . وعلى عكس الفكرة الأولى ، فقد تم إضافة ميزة حذف مجلد من جوجل درايف بشكل مباشر أيضاً . للأشخاص الذين يرغبون في إعادة تصفير إعدادات الأداة وحذف القيم كاملة ةاستخدام الأداة كإنها جديدة ، تم إضافة ميزة مخفية تقوم بتصفير اعدادات الأداة عند النقر المستمر مدة 6 ثواني على زر النسخ ، ثم ستظهر رسالة تخبرك بأنه تم إعادة ضبط الإعدادات وسيتم إعادة تشغيل الأداة من جديد . 🔴 وجب التنبيه أن هذه الخطوة ستقوم بحذف رمزي ( CLIENT ID و CLIENT SECRET ) اللذين من المفترض أنك حصلت عليهما باتباعك الخطوات السابقة عند إنشائك المشروع . ولإعادة الحصول عليهما ، فقط توجه للرابط ، ثم اختر اسم مشروعك ، ثم تفعيل خدمات API ثم انتقل الى التبويب credentials واختر اسم مشروعك وستجدهما في الصفحة كما في الصورة الأخيرة في رأس الموضوع . النسخة الجديدة متاحة للتحميل للنسختين 32 و 64 . نسخة 32 | نسخة 64 ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ Uploader 32.zip | Uploader 64.zip ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ صورة للواجهة الجديدة مع الإضافات .

بارك الله فيك صديقي ,, دائماً التوضيح في الطلب والشرح الكافي و الوافي حتى لو في 100 سطر ، يعود لك بالنتيجة المطلوبة التي تبحث عنها . أتمنى لك الفائدة دائماً

جرب هذا التعديل .. 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 If Month(Now()) = 3 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #1/1/" & Year(Now()) & "# And #2/28/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If If Month(Now()) = 7 Then If Nz(DLookup("Payment_Made", "tbl_Loans", "EmployeeID=" & rstE!EmployeeID & _ " And [Payment_Made]=3000 And [Payment_Month] Between #4/1/" & Year(Now()) & "# And #6/30/" & Year(Now()) & "#"), 0) = 3000 Then rstE.MoveNext GoTo NextEmployee End If End If 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 NextEmployee: 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