Foksh

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

زر الفلترة من المفترض حسب ما فهمت هو باختيار الاسم واللقب . تريد الفلترة بالاسم الأول أو الثاني ؟؟؟؟ ولا كلاهما كشرط للفلترة !!!! جرب هذا التعديل 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

وعليكم السلام ورحمة الله وبركاته ,, أعاننا الله وإياكم على تحقيق المطلوب .. بدايةً سيتم التحقق من شهر الاقتطاع (3 أو 7 ) ، ثم سيتم البحث عن أي دفع مباشر ( 3000 ) في الفترة المحددة كالآتي :- جانفي / فيفري لشهر مارس أفريل/ماي/جوان لشهر جويلية الآن سيتم تخطي الموظف إذا وجد له عملية دفع مباشر في الفترة المحددة . إلى الآن هل هذا صحيح ..؟؟؟ وأخبرني كيف سأعرف أن النتيجة المطلوبة تحققت !!! في الجدول أم أين ؟؟

أهلاً أخي @gavan .. هذه العبارة دلالة على انك بعد الحصول على رمز التفويض ( بتسجيل دخولك بالايميل الخاص بالخدمة ) تستطيع تسجيل خروج من المتصفح وإزالة الايميل ولا حاجة لنا به !!!! وطبعاً بما أنك ستدخل وتستخدم خدمات اي موقع فهو يطلب منك تسجيل الدخول بحسابك ( وهذا منطقي ) . كأنك تريد تثبيت برنامج Google Drive على كمبيوتر العميل وتقول له ارفع ملفاتك دون تسجيل الدخول . اتمنى تكون الفكرة وصلت

بعد نجاح فكرة أستاذنا @jjafferr ما شاء الله وتبارك الله ، مشاركة بعد وعي للمطلوب أستاذ @ابوخليل .. اعتقد اننا نستطيع الاستغناء عن الاستعلام الأول ، ونكتفي باستعلام التحديث مبني على استعلام فرعي داخلي UPDATE Table1 SET Table1.chek1 = 0 WHERE Table1.userID IN ( SELECT Table2.user_ID FROM Table2 GROUP BY Table2.user_ID, Table2.card_No HAVING Sum(Table2.price1) - Sum(Table2.price2) = 0 ) AND Table1.cardNo IN ( SELECT Table2.card_No FROM Table2 GROUP BY Table2.user_ID, Table2.card_No HAVING Sum(Table2.price1) - Sum(Table2.price2) = 0 ); New Idea.accdb

لا شكر على واجب اخي الكريم في هذا الجزء يتم فعلاً الذهاب للسجل الذي تم إضافته 🤔 .

اذا ، جرب الكود التالي :- Private Sub Command137_Click() On Error GoTo ErrorHandler Dim db As DAO.Database Dim newID As Long Dim oldID As Long Dim newINVNo As Long If IsNull(Me.id) Then Exit Sub Set db = CurrentDb oldID = Me.id newINVNo = Nz(DMax("[INVNo]", "HTable"), 3000) + 1 db.Execute "INSERT INTO HTable " & _ "([INVNo], [Fdate], [compcode], [comName], [TaxId], [Note]) " & _ "SELECT " & newINVNo & ", Fdate, compcode, comName, TaxId, Note " & _ "FROM HTable WHERE ID = " & oldID newID = DMax("ID", "HTable") db.Execute "INSERT INTO Irsal " & _ "(IDNO, SenfNO, senfname, NetWight, price, Total) " & _ "SELECT " & newID & ", SenfNO, senfname, NetWight, price, Total " & _ "FROM Irsal " & _ "WHERE IDNO = " & oldID Me.Requery Me.RecordsetClone.FindFirst "ID = " & newID Me.Bookmark = Me.RecordsetClone.Bookmark ExitHere: Set db = Nothing Exit Sub ErrorHandler: MsgBox Err.Description & vbNewLine & _ "رقم الخطأ: " & Err.Number, vbCritical Resume ExitHere End Sub 60000.accdb

فيما يتعلق لما فهمته ، هل النتيجة في المرفق صحيحة ؟؟؟ اولاً شغل اٌستعلام Query3 لأنشاء جدول مؤقت ، ثم شغل الإستعلام Query4 Database1.accdb

من باب التوضيح !! هل سيتم تحديث قيمة chek1 بشرط userID = aa بناءً على ما فهمت ؟؟ حسب قيمة pp = 0 ستعود على aa !