نجوم المشاركات

مافي داعي تعمل معيارين على حقلين ، وانما اجعل الشرطين في استعلام واحد ، هكذا : UPDATE Table1 SET Table1.chek1 = 0 WHERE (((Table1.userID) In ( SELECT T2.user_ID FROM Table2 AS T2 GROUP BY T2.user_ID, T2.card_No HAVING (Sum([price1])-Sum([price2]))=0 AND Table1.userID=T2.user_ID AND Table1.cardNo=T2.Card_No)) );

اوووه وانا اعتمدت على على العموم ، هذا الاستعلام بعد اضافة pp=0 UPDATE Table1 SET Table1.chek1 = 0 WHERE (((Table1.userID) In (SELECT [user_ID] FROM Query1 as Q1 WHERE Table1.userID=Q1.user_ID AND Table1.cardNo=Q1.card_No AND Q1.pp=0))); 1623.Database2.accdb

ما رايكم في هذا حتى مع ادخال القيم من جدول HH.accdb

أخي @ناقل ، ما رأيك بهذه الفكرة ؟ BackLight3.accdb

اخوتي @jjafferr @Foksh الجمل الأخيرة كلها تعمل واصبح هذا الموضوع متنوع الثمار .. كل يأخذ حسب حاجته .. اعجبتني آخر جملة الف شكر لجميع من شارك في هذا الموضوع

غفر الله لوالدك ووالدينا واللهم ارحمه، ووسّع نزله، وأكرم مدخله، واجمعنا به في مستقر رحمتك، اللهم ارحمنا إذا صرنا إلى ما صار، إليه لا حول ولا قوة إلا بالله. اللهم إن المتوفى في كفالتك وضيافتك، فهل جزاء الضيف إلا الإكرام والإحسان وأنت أهل الجود والكرم. ودعائي لك اخي الحبيب :اللهمّ افتح له أبواب حكمتك، وانشر عليه رحمتك، واجعل للنّجاح من حياته نصيباً. اللهمّ اكتب له النّجاح في الدّنيا والآخرة، ووفّقه لكلّ ما تحبّ وترضى. اللهمّ إنّك أنت القادر على كلّ شيء، وأنت المُعطي والمانع، وأنت المُيسّر لكلّ خير، ما تشاء من أمرٍ يكون، وفّقه للنّجاح في جميع أموره.

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

وهو كذلك التعديل كان في محله بوركت استاذ Foksh ربي يحفطك

طيب وممكن رايكم بالكود التالى Private Sub y_n_Click() On Error GoTo ErrorHandler Dim sql As String Dim currentID As Variant ' حفظ السجل الحالي If Me.Dirty Then Me.Dirty = False End If ' الحصول على معرف السجل الحالي currentID = Me!id ' تحديث كافة السجلات لإلغاء التحديد sql = "UPDATE a SET y_n = False" CurrentDb.Execute sql, dbFailOnError ' تعيين السجل الحالي فقط sql = "UPDATE a SET y_n = True WHERE ID = " & currentID CurrentDb.Execute sql, dbFailOnError ' تحديث النموذج لإظهار التغييرات Me.Requery ' العودة إلى السجل الحالي Me.Recordset.FindFirst "ID = " & currentID Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbExclamation, "Error" Debug.Print "حدث خطأ: " & Err.Number & "|" & Err.Description Exit Sub End Sub HH.accdb

هههههههه انا حسيت ان فى شئ غير صحيح وكنت استحى ان اذكر ذلك توقعت اننى المخطئ فى فهمى

جرب هذا التعديل .. 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

ممتاز لم اجد اي خطأ وعالج مشكلة التعديل من الجدول استاذ يا ابا عارف 🌹 اخونا الشايب

تفضل الاستعلام UPDATE Table1 SET Table1.chek1 = 0 WHERE (((Table1.userID) In (SELECT [user_ID] FROM Query1 as Q1 WHERE Table1.userID=Q1.user_ID AND Table1.cardNo=Q1.card_No))); . وهنا وقعت في المحظور ايضا !! بياناتك كلها متشابهه ، فعلشان احصل على سجل واحد ، عملت تغيير لبيانات cardNo في الجدول Table1 وابقيت سجل واحد فيه قيمة الجدول Table2 1623.Database2.accdb.zip

هذه نتيجة العمل آخر الليل .. فاعذرني وسامحني من اين جاءت الـــ bb ؟؟ انا مخطىء وايضا المثال ناقص السبب اني اعمل على برنامج وصنعت هذا المثال على عجل من اجل التسهيل .. وكما يقال آخر العجلة الندامة @ابو جودي كودك شغال تمام لما استبدل الــ bb بـــ cc ولكنه يقوم بتحديث جميع حقول الــ cc يعني من الآخر مثالي ناقص ارفقت مثالي الصحيح .. والمطلوب ان التحديث يتم عند تطابق حقلين وليس حقل واحد useriD و cardNo Database2.rar اهلا اخوي جعفر .. هو ما ذكرته اعلاه 🙈

السلام عليكم اذا ممكن اشارك معاكم 🙂 الاستعلام الفرعي هو الجواب بدلا عن الجدول المؤقت. رجاء تجربة هذا الاستعلام: UPDATE Table1 SET Table1.chek1 = 0 WHERE (((Table1.userID) In (SELECT [user_ID] FROM Query1 as Q1 WHERE Table1.userID=Q1.user_ID AND Q1.pp=0))); . وقد قام بالتحديث (ولكن انتبه ن فقيمة p=0 موجودة فقط في السجل bb وهو غير موجود في الجدول Table1 ، لذا فلن تظهر لك اي نتيجة ، وهذا ما اشار اليه اخوي ابو جودي) ، وللتجربة ، غيّر قيمة P=0 في الاستعلام الفرعي الى p=15 وستترى النتيجة 1623.Database1.accdb.zip

الحقيقة انك صرحت بما في نفسي تمام ولكني تعمدت عدم ذكره لغرض الحصول على اكثر من فكره بكل امانة قبل مشاركة الاساتذة جربت طريقتين التعامل مع مصدر السجلات في الجدول استعلام مشابه لعمل الاستاذ ابو عارف وعمل بشكل ممتاز واعتقد هو الافضل والاسهل اما بشأن 👇 ولكن هل الامر يستحق اضافة عدة اسطر لمعالجة ما يستجد من ملاحظات اخيرا مشاركتك الاخير تؤدي المطلوب ولكن ايضا تحتاج الى عدة اختيارات في حال وجود اختيار مسبق في الجدول وانا اعلم كما اشرتم 👇 ولكن قد يكون التعديل من نموذج اخر لغرض تحديث او تصفية لتقرير او او .... الخ الشايب

جميل جدا ..... بارك الله فيك ... ماشاء الله تبارك الله دائما مبدع .... انا الحقيقة انشغل في برنامج خاص بي .. لكنك سبقت واجدت المطلوب

تسلم ايديك يا عبقري @Foksh ، وجعله في ميزان حسناتك ، كود اكثر من رائع بس طمعا في عبقريتك لو ما بدي اتعبك معاي ، تضيف لي عالكود جزء يغلق النموذج ويفتح السجل الجديد المكرر ، ولك مني جزيل الشكر

وعليكم السلام اتفضل اطلع ع هذا الموضوع شيخنا الجليل @ابوخليل بالتوفيق

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

تفضل أخي العزيز .. ولزيادة الخير وضعت لك أكواد جميع الإجراءات الأساسية : الإجراءات الإعتيادية للسجلات ( حفظ - جديد - حذف - إضافة - تكرار - التالي - السابق - الأول - الأخير - .....) '===================================== حفظ السجل والذهاب لسجل جديد Private Sub SaveRecBtn_Click() On Error GoTo Err_SaveRecBtn_Click DoCmd.RunCommand acCmdSaveRecord DoCmd.GoToRecord , , acNewRec Exit_SaveRecBtn_Click: Exit Sub Err_SaveRecBtn_Click: MsgBox Err.Description Resume Exit_SaveRecBtn_Click End Sub '===================================== حذف السجل Private Sub DeleteBtn_Click() On Error GoTo Err_DeleteBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Exit_DeleteBtn_Click: Exit Sub Err_DeleteBtn_Click: MsgBox Err.Description Resume Exit_DeleteBtn_Click End Sub '===================================== إضافة سجل جديد Private Sub AddNewBtn_Click() On Error GoTo Err_AddNewBtn_Click DoCmd.GoToRecord , , acNewRec Exit_AddNewBtn_Click: Exit Sub Err_AddNewBtn_Click: MsgBox Err.Description Resume Exit_AddNewBtn_Click End Sub '===================================== السجل التالي Private Sub NextBtn_Click() On Error GoTo Err_NextBtn_Click DoCmd.GoToRecord , , acNext Exit_NextBtn_Click: Exit Sub Err_NextBtn_Click: MsgBox Err.Description Resume Exit_NextBtn_Click End Sub '===================================== السجل السابق Private Sub PreviousBtn_Click() On Error GoTo Err_PreviousBtn_Click DoCmd.GoToRecord , , acPrevious Exit_PreviousBtn_Click: Exit Sub Err_PreviousBtn_Click: MsgBox Err.Description Resume Exit_PreviousBtn_Click End Sub '===================================== السجل الأول Private Sub FirstBtn_Click() On Error GoTo Err_FirstBtn_Click DoCmd.GoToRecord , , acFirst Exit_FirstBtn_Click: Exit Sub Err_FirstBtn_Click: MsgBox Err.Description Resume Exit_FirstBtn_Click End Sub '===================================== السجل الأخير Private Sub LastBtn_Click() On Error GoTo Err_LastBtn_Click DoCmd.GoToRecord , , acLast Exit_LastBtn_Click: Exit Sub Err_LastBtn_Click: MsgBox Err.Description Resume Exit_LastBtn_Click End Sub '===================================== البحث عن سجل Private Sub FinedRecBtn_Click() On Error GoTo Err_FinedRecBtn_Click Screen.PreviousControl.SetFocus DoCmd.RunCommand acCmdFind Exit_FinedRecBtn_Click: Exit Sub Err_FinedRecBtn_Click: MsgBox Err.Description Resume Exit_FinedRecBtn_Click End Sub '===================================== تكرار السجل Private Sub DublicateRecBtn_Click() On Error GoTo Err_DublicateRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Exit_DublicateRecBtn_Click: Exit Sub Err_DublicateRecBtn_Click: MsgBox Err.Description Resume Exit_DublicateRecBtn_Click End Sub '===================================== حفظ السجل Private Sub SaveRecBtn_Click() On Error GoTo Err_SaveRecBtn_Click DoCmd.RunCommand acCmdSaveRecord Exit_SaveRecBtn_Click: Exit Sub Err_SaveRecBtn_Click: MsgBox Err.Description Resume Exit_SaveRecBtn_Click End Sub '===================================== طباعة السجل الحالي Private Sub PrintRecBtn_Click() On Error GoTo Err_PrintRecBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.PrintOut acSelection Exit_PrintRecBtn_Click: Exit Sub Err_PrintRecBtn_Click: MsgBox Err.Description Resume Exit_PrintRecBtn_Click End Sub '===================================== التراجع عن التسجيل Private Sub UndoRecBtn_Click() On Error GoTo Err_UndoRecBtn_Click DoCmd.RunCommand acCmdUndo Exit_UndoRecBtn_Click: Exit Sub Err_UndoRecBtn_Click: MsgBox Err.Description Resume Exit_UndoRecBtn_Click End Sub '===================================== فتح التقرير وطباعة السجل المحدد بدلالة الرقم التسلسلي Private Sub Print_Click() On Error GoTo Err_OpenReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewReport, , "ID =" & Me.ID DoCmd.RunCommand acCmdPrintPreview DoCmd.RunCommand acCmdPrint Exit_OpenReportBtn_Click: Exit Sub Err_OpenReportBtn_Click: If Err.Number = 2501 Then Resume Exit_OpenReportBtn_Click 'print cancelled MsgBox Err.Number & vbCr & Err.Description Resume Exit_OpenReportBtn_Click End Sub '===================================== طباعة تقرير Private Sub PrintReportBtn_Click() On Error GoTo Err_PrintReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acNormal Exit_PrintReportBtn_Click: Exit Sub Err_PrintReportBtn_Click: MsgBox Err.Description Resume Exit_PrintReportBtn_Click End Sub '===================================== معاينة تقرير Private Sub VeiwReportBtn_Click() On Error GoTo Err_VeiwReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acPreview Exit_VeiwReportBtn_Click: Exit Sub Err_VeiwReportBtn_Click: MsgBox Err.Description Resume Exit_VeiwReportBtn_Click End Sub '===================================== فتح تقرير Private Sub OpenReportBtn_Click() On Error GoTo Err_OpenReportBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OpenReport stDocName, acViewReport Exit_OpenReportBtn_Click: Exit Sub Err_OpenReportBtn_Click: MsgBox Err.Description Resume Exit_OpenReportBtn_Click End Sub '===================================== حفظ تقرير بصيغة Private Sub SendReportToBtn_Click() On Error GoTo Err_SendReportToBtn_Click Dim stDocName As String stDocName = "ReportName" DoCmd.OutputTo acReport, stDocName Exit_SendReportToBtn_Click: Exit Sub Err_SendReportToBtn_Click: MsgBox Err.Description Resume Exit_SendReportToBtn_Click End Sub

جرب هذا الملف تصفيةبشرطين salim.xlsm

مشكورين جميعا اخواني لمروركم الكريم تقبلو خالص تحياتي اما بخصوص البحث بشروط تفضلو التعديل بحث باي شرط الى شرط التاريخ كما طلب الاخ عاطف وشكرا SERCH_ARRY_YASSER_ELARABY1.rar

السلام عليكم جرب هذه =SUMPRODUCT(--(C2:C101="غ");SUBTOTAL(3;OFFSET(C2;ROW(C2:C101)-ROW(C2);0))) للامانة هي منقولة http://www.mrexcel.com/forum/excel-questions/600223-subtotal-countif.html تحياتي

السلام عليكم و رحمة الله وبركاته ‏الثلاثاء‏، 15‏/2‏/1430هـ. الموافق ‏10‏/2‏/09م برنامج التذكير بالمواعيد و دليل تلفون هاتف و ايميل مع بحث سريع الموضوع طلب على الرابط http://www.officena.net/ib/index.php?s=&am...st&p=129102 أخي الفاضل ارفق لك نسخة من الملف الذي استخدمة – حيث وضعته في بدأ التشغيل بحيث يقوم ويندوز بتشغيلة تلقائيا عند تشغيل الجهاز وبه 1- صفحة المواعيد تقوم بتسجيل المواعيد المهمة مرة واحدة في تواريخها بالهجري او الميلادي يتم تلقائيا تحويل التاريخ الهجري الى الميلادي ان تم ادخال التاريخ الهجري في الخانة المخصصة في كل مرة يتم الدخول للصفحة يتم - ترتيب البيانات حسب التاريخ تلقائيا - تظهر العمليات المطلوبة خلال 30 يوما من تاريخ اليوم فقط - العمليات التي تم الإنتهاء منها تقوم بتسجيل منتهي في اول عمود لكي لا تظهر مرة اخرى 2 – دليل تلفونات و ايميلات مع امكانية البحث السريع بحيث - يمكن البحث بأي جزء من الإسم - يمكن البحث بأي جزء من الرقم للتلفون آمل ان تستفيد منه مع خالص التحية و التقدير AhmedY.rar