kanory

واياك...

وهذه طريفة اخرى اقل اكواد <><><><><><><> Dim db As DAO.Database Set db = CurrentDb() db.Execute "DELETE template.UsrID, * FROM template WHERE (((template.UsrID) In (SELECT No_Common FROM QRFingerDelete)))", dbFailOnError Set db = Nothing

وعليكم السلام تفضل <><><><><><><><> Dim rs As DAO.Recordset Dim R As Integer Set rs = CurrentDb.OpenRecordset(" SELECT TB_1.No_Common " & _ " FROM TB_1 INNER JOIN TB_2 ON TB_1.No_Common = TB_2.No_Common " & _ " WHERE (((TB_2.End_Date)<=Date()-1) AND ((TB_2.Case_Com)=102) AND ((TB_2.jadd)=False));", dbOpenDynaset) rs.MoveLast rs.MoveFirst R = rs.RecordCount For i = 1 To R DoCmd.SetWarnings False DoCmd.RunSQL "DELETE template.id, template.FingerTmplate, template.UsrID " & _ " FROM template " & _ " WHERE (((template.UsrID)=" & rs!No_Common & "));" DoCmd.SetWarnings True rs.MoveNext Next i rs.Close Set rs = Nothing

طيب ، سأشرح لك الدالة `GenerateSequence` هذه الدالة تقوم بإنشاء تسلسل رقمي للاسماء المتشابهة في استعلام : 1. `Function GenerateSequence( FullName As String) As Integer`: هذا تعريف الدالة `GenerateSequence` التي تأخذ مُدخل واحد يُسمى ` FullName` من نوع `String` وتُرجع قيمة من نوع `Integer`. 2. `Static dict As Object`: هنا نُعرف متغير `dict` ككائن `Object`. الكلمة `Static` تعني أن الكائن `dict` سيحتفظ بقيمته حتى بعد انتهاء تنفيذ الدالة، وهذا مهم لأننا نريد أن يحتفظ القاموس بالاسماءوالأرقام المتسلسلة التي تم إضافتها سابقًا. 3. `If dict Is Nothing Then Set dict = CreateObject("Scripting.Dictionary")`: هذا الشرط يتحقق إذا كان الكائن `dict` لم يتم إنشاؤه بعد، وفي هذه الحالة يتم إنشاء كائن جديد من نوع "Dictionary" (قاموس). 4. `If Not dict.exists( FullName) Then`: هذا الشرط يتحقق إذا كان الاسم` FullName` غير موجود في القاموس `dict`. 5. `dict.Add FullName, dict.Count + 1`: إذا كان الاسم` FullName` غير موجود، يتم إضافته إلى القاموس مع قيمة تسلسل رقمي جديدة تُحسب بإضافة واحد إلى عدد الاسماء الموجودة في القاموس. 6. `GenerateSequence = dict( FullName)`: في النهاية، تُرجع الدالة القيمة المتسلسلة للاسم` FullName` الموجود في القاموس. باستخدام هذه الدالة في استعلام، يمكنك إنشاء حقل محسوب يعرض رقمًا متسلسلًا لكل اسم متشابه بناءً على ترتيب ظهوره في الاستعلام. هذا مفيد لتتبع الاسماء وترتيبها بشكل فريد داخل الاستعلام.

طيب تفضل <<<<<<<<>>>>>>>> تقرير اجازات.accdb

هل تريدها بهذا الشكل ؟؟؟

اقرأ هذا الموضوع وسوف يساعدك في ذلك ...................................

ممكن في وحدة نمطية وتناديها من النموذج او تعمل زر وتلصق الكود مباشرة فيه بالتوفيق

Dim rs As DAO.Recordset Dim rs1 As DAO.Recordset Dim R As Integer Dim firstRecordFields As String Dim firstRecordFields1 As String Set rs1 = CurrentDb.OpenRecordset("SELECT Table1.الاسم FROM Table1 GROUP BY Table1.الاسم;", dbOpenDynaset) rs1.MoveLast: rs1.MoveFirst R = rs1.RecordCount For i = 1 To R Set rs = CurrentDb.OpenRecordset("SELECT Table1.الاسم, Table1.العمل1, Table1.العمل2, Table1.اللجنة1, Table1.اللجنة2 " & _ " FROM Table1 " & _ " WHERE (((Table1.الاسم)=""" & rs1!الاسم & """));", dbOpenDynaset) If Not (rs.BOF And rs.EOF) Then rs.MoveLast firstRecordFields = rs!العمل1 firstRecordFields1 = rs!اللجنة1 rs.MoveFirst rs.Edit rs!العمل2 = firstRecordFields rs!اللجنة2 = firstRecordFields1 rs.Update End If rs1.MoveNext Next i rs.Close rs1.Close Set rs = Nothing Set rs1 = Nothing لهذا كان السؤال .... لان الكود أو البرنامج ممكن يعلق يوقف يحدث خطأ ما ... عندها لن تستطيع العودة لتلك البيانات .... على العموم جرب هذا الكود وبدون حذف ,,, فقط تحديث للبيانات

رغم ان العنوان لا يمثل المطلوب وهذا مخالف لترتيبات وقوانين المنتدى ..... لكن بعد الدمج ماهو مصير السجل الثاني ( هل يحذف أم يبقى في الجدول ) .......

طيب ممكن نستخدم هذه الطريقة .... ولكن يبقى ايضا نقطة مربعات التسمية وعددها في النموذج ؟؟؟؟؟ Dim db As Object Dim rst As DAO.Recordset Dim mySQL As String Dim i, m As Integer mySQL = "SELECT DISTINCT جدول1.[اسم العامل], DSum(""راتب"",""جدول1"",""[اسم العامل] ='"" & [اسم العامل] & ""'"") AS Expr1 FROM جدول1;" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst If Not rst.BOF Then rst.MoveFirst Dim ctl As Control For i = 1 To rst.RecordCount Me.Controls("a" & i).Caption = "مجموع" & " " & rst.Fields(0) Me.Controls("b" & i).Caption = rst.Fields(1) rst.MoveNext Next i rst.Close Set rst = Nothing مثال (5).accdb

جرب المرفق ..................... New Microsoft Access Database (9).accdb

انا اعتذر منك على المواصلة .....

جرب هذا ........ Private Sub Order_No_AfterUpdate() D_R = DateAdd("d", -3, Date) On Error GoTo Errw DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Me.supplier = "مرفوض" And Me.mark = 0 And Format(Me.inday, "dd/mm/yyyy") <= Format(D_R, "dd/mm/yyyy") And IsNull(Me.P_Odate) Then DoCmd.GoToRecord , , acLast DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord Me.Order_No.SetFocus MsgBox "لايمكن اضافة جديد" Exit Sub Else Me.Order_No.SetFocus End If DoCmd.GoToRecord , , acNext Next i Exit Sub Errw: End Sub

تغضل طبق على مثالك

واياك اخي الكريم

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

ممكن تعمل هكذا .... طبعا مختلف عما تريد ( قوائم تشبه قوائم الاكسس علوية ) .....

راجع المرفق وتأكد فقط الان من الشروط الاربعة هل تحققت .......... Datab (officena).accdb

فقط المحدد ..... جرب

تفضل .... Private Sub Command6_Click() If CheckA.Value = True Then DoCmd.OpenReport "Report1", acViewPreview End If If CheckE.Value = True Then DoCmd.OpenReport "Report4", acViewPreview End If If CheckC.Value = True Then DoCmd.OpenReport "Report2", acViewPreview End If If CheckD.Value = True Then DoCmd.OpenReport "Report3", acViewPreview End If End Sub

هل تسلسل السجل الظاهر لدينا في الصورة دائما اول سجل ام هناك اختلاف في تسلسله ( اقصد الان ظاهر كاول سجل ... هل ممكن ان يكون في مرات اخرى ثان او ثالث سجل مثلا )

لم افهم ؟؟؟؟

طيب شوف كدة ..... بداية ... kan_1.accdb