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

اعمل زر وضع فيه التالي :::: Me.QareeWeb.SetFocus DoCmd.RunCommand acCmdInsertHyperlink جرب واخبرنا

خيار آخر قد يكون أسرع Sub test() Dim i As Integer Dim r As Range: Dim tr As Range With ActiveSheet For i = 1 To .UsedRange.Rows.Count + 2 If Trim(.Cells(i, 3)) = "تعديل" Then If r Is Nothing Then Set r = .Rows(i) Else Set r = Union(r, .Rows(i)) End If End If Next i r.Delete End With End Sub

بعد اذن اخواني تفضل هذه المشاركة اخي الكريم ملف تجريبي.zip

تحياتي الخالصة مع أني لم أفهم المطلوب جيدا أقدم هذه الحل في الملف المرفق... 1.xlsx

مخالف لقواعد المشاركة 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف يغلق ،،،

السلام عليكم 🙂 للتجربة والتأكد من اني فهمت الموضوع ، رجاء عمل التالي: 1. شغل الدالة Make_Groups ، وذلك بكتابة اسمها في الاسفل ، ورجاء التأكد ان علامة الاستفهام بالانجليزي ، ثم انقر على زر Enter على الكيبورد . عندما تنتهي الدالة من عملها ، ستظهر لك رسالة "Done" ، عندها رجاء تشغيل الاستعلام qry_Vacations والتأكد بأن بياناتها كما تريد 🙂 الدالة تضع بياناتها في الجدول tbl_V_Seq ، وهو جدول تجميع الاجازات المستمرة 🙂 1581.سجل المحضرين_be.accdb.zip

وعليكم السلام هذه المشكلة تحدث إذا كان التنسيق ليس رقم فرز.xlsx

زيادة لما تفضل به استاذنا @Moosak استخدم هذا ... جرب ... Private Sub Report_Open(Cancel As Integer) DoCmd.Maximize Me.kan.Left = (Me.Width - Me.kan.Width) / 2 End Sub

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

السلام عليكم 🙂 - تم الغاء الجدول tbl_V_Seq ، - تم اضافة الحقل Seq الى الجدول tblVacations ، - يمكنك نقل هذه الدالة الى برنامج الواجهة ، واستعماله هناك ، - يجب استعمال هذه الدالة مرة واحدة فقط ، لأنها في كل مرة تحذف البيانات السابقة ، - اقترح اضافة الحقل Seq الى نموذج الاجازات ، ويدويا تعطيه: رقم التسلسل للاجازة السابقة ، اذا كانت الاجازة الجديدة استمرار للاجازة السابقة ، الرقم التسلسل التالي. Option Compare Database Option Explicit Function Make_Groups() 'نريد عمل لكل اجازات مستمرة ، مجموعة خاصة بها 'وبما انه لا توجد معلومة مميزة في السجل لتوضح الفرق بين الاجازة العادية والاجازة المستمرة 'فوجب التفكير في عمل هذه المجموعات 'ورأيت ان اسهل طريقة لعمل هذه المجموعات ، هو عمل رقم مسلسل لكل سجل 'فالاجازات المستمرة يكون لها نفس الرقم ، وعند انتهائها ، فالسجل التالي يحصل على الرقم المسلسل التالي ' ' 'بعد تحليل البيانات، اتضح ان الاجازة المستمرة معناها 'تاريخ بداية الاجازة الجديدة = تاريخ نهاية الاجازة السابقة + 1 (يوم واحد) ' 'فعليه، بدأنا بأول اجازة وتم اعطاءها رقم مسلسل 'ثم ننتقل الى السجل التالي ، ونتأكد من نتائج المعادلة اعلاه 'فإذا كانت النتيجة نفسها ، فمعناه انها اجازة مستمرة ونعطي السجل نفس الرقم 'واذا كانت الاجازة منقطعة ، فنقوم بإضافة 1 الى الرقم المسلسل ، وهكذا ' ' 'tbl_V_Seq تم الغاء الجدول 'واضافة الحقل Seq 'الى الجدول 'tblVacations ' Dim rstV As DAO.Recordset Dim rstVG As DAO.Recordset Dim Seq As Long Dim Last_EndDate As Date 'rstV = tblVacation بيانات الجدول 'rstVG = tblVacation Group By emp_code ارقام الموظفين بدون تكرار من الجول 'تنظيف الحقل Seq من البيانات السابقة CurrentDb.Execute ("UPDATE tblVacation SET Seq = Null") 'ارقام الموظفين بدون تكرار، والفرز تصاعدي Set rstVG = CurrentDb.OpenRecordset("SELECT emp_code FROM tblVacation GROUP BY emp_code ORDER BY emp_code") rstVG.MoveFirst 'حلقة دوران حتى نشمل جميع الموظفين Do Until rstVG.EOF 'سجلات كل موظف Set rstV = CurrentDb.OpenRecordset("SELECT * FROM tblVacation WHERE emp_code=" & rstVG!emp_code) 'اذا لا توجد بيانات للموظف، ابدأ التسلسل 1 If rstV.RecordCount = 0 Then 'No Record Seq = 1 End If 'اول قيمة للمقارنة ، ونجعلها فارغة Last_EndDate = 0 'حلقة دوران لمقارنة سجلات الموظف Do Until rstV.EOF 'اذا تاريخ نهاية الاجازة تساوي تاريخ نهاية الاجازة السابقة+1 If rstV!VacationStartDate = Last_EndDate Then 'نعم 'اعمل تعديل على السجل، واعطيه رقم التسلسل السابق rstV.Edit rstV!Seq = Seq rstV.Update Else 'لا 'اعمل تعديل على السجل، واعطيه رقم التسلسل السابق+1 rstV.Edit Seq = Seq + 1 rstV!Seq = Seq rstV.Update End If 'تاريخ نهاية الاجازة+1 Last_EndDate = rstV!VacationEndDate + 1 rstV.MoveNext Loop rstVG.MoveNext Loop rstV.Close: Set rstV = Nothing rstVG.Close: Set rstVG = Nothing MsgBox "Done" End Function جعفر 1581.1.سجل المحضرين_be.accdb.zip

Sub test() Dim i As Integer With ActiveSheet For i = .UsedRange.Rows.Count + 2 To 1 Step -1 If Trim(.Cells(i, 3)) = "تعديل" Then .Rows(i).Delete End If Next i End With End Sub

السلام عليكم استاذنا الفاضل حسونة حسين الكود بعد التعديل يعمل و الحمد لله الف الف شكر لحضرتك

ما فهمت.. وضح بمثال شفتها بالموضوع الخاص بها بس ما فهمت المطلوب أرجو التوضيح أكثر وذكر أمثلة في موضوعها الخاص بها عملت فقط بند مدة افتراضية ولم أكمل لأن المعادلات ستصبح طويلة بسبب الاشتراطات إذا يقدر أحد من الأعضاء يكمل أو تقتنع بالموجود التعديل كان في ورقة جديدة مدة الخدمة حسم وإضافة (1) (2).xlsx

شوقتنا نعرف تفاصيل أكثر عن البرنامج ؟ 😊

وعليكم السلام ورحمة الله وبركاته .. 🙂 في خصائص النموذج .. والنتيجة : وفي خصائص التقرير كذلك .. والنتيجة : ترتيب حسب اللقب.accdb

السبب لأن تعديل في الجدول قبلها مسافة " تعديل"

جرب هذا .... Sub CloseAllFormsAndReportsExceptOne() Dim obj As AccessObject For Each obj In CurrentProject.AllForms If obj.IsLoaded And Not obj.Name = "FormToKeepOpen" Then DoCmd.Close acForm, obj.Name End If Next obj For Each obj In CurrentProject.AllReports If obj.IsLoaded And Not obj.Name = "ReportToKeepOpen" Then DoCmd.Close acReport, obj.Name End If Next obj End Sub

وعليكم السلام اذا البرنامج مقسم عندك الى جزئين: - جزء الجداول (الجزء الخلفي او BE) : فالمنتدى مليء بطرق اخذ النسخ الاحتياطية ، بما لذ وطاب ، فقط استخدم خاصية البحث فيه ، - جزء البرنامج (الجزء امام المستخدم او FE) : فهذا تاخذ منه نسخة واحدة فقط عند عمل تغيير به ، ولا تحتاج الى عمل نسخ اضافية اخرى منه.