Foksh

قد يكون تنسيق الوقت !!! لكن انظر الوقت والتنفيذ الآن .. دعنا منها الآن .👍. طبعاً إذا كان لكل فترة وقت إتاحة مخصص ومختلف عن الفترة السابقة . أي لا نريد شمول الفترات جميعها بوقت إتاحة ثابت !! ومن هنا كل شيء سيكون عبارة عن بيانات وليس برمجة .. وهذه خطوة ذكية جداً أنك ستعتمد على حقول محسوبة .. وعلى سبيل المثال بهذا الشكل رح نعتمد على start_signin و end_signout بدل ما نعتمد على VBA ( start_signin و end_signout = حقلين افتراضيات يعبران عن بداية ونهاية التوقيع )

معلمي الفاضل .. بناءً على ما أسلفتم ، ومن خلال الجدول الجديد الخاص بالتحكم :- تم تعديل اسلوب مطابقة الفترة لتراعي السماح قبل و بعد . التحقق من آخر توقيع للموظف بحيث إذا مضى عليه أقل من waitBtween دقيقة ، فيتم رفض التوقيع الجديد . وبناءً عليه ، يكون تعديلي بهذا الشكل :- Private Sub ID_AfterUpdate() On Error GoTo Err_Handler Dim db As DAO.Database Dim rsEmp As DAO.Recordset Dim rsShift As DAO.Recordset Dim rsCtrl As DAO.Recordset Dim rsLastMove As DAO.Recordset Dim UserId As String Dim empName As String Dim currentTime As Date Dim shiftId As Variant Dim checkType As String Dim sql As String Dim periodName As String Dim startWork As Date, endWork As Date Dim allowedBefore As Long, allowedAfter As Long, waitBetween As Long Dim lastTime As Date UserId = Trim(Me.id) If UserId = "" Then MsgBox "يرجى إدخال رقم الموظف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If currentTime = Time() Set db = CurrentDb sql = "SELECT * FROM tblNames WHERE UserId = '" & UserId & "'" Set rsEmp = db.OpenRecordset(sql) If rsEmp.EOF Then MsgBox "رقم الموظف غير موجود في جدول الموظفين", vbExclamation + vbMsgBoxRight, "" rsEmp.Close Exit Sub End If empName = Nz(rsEmp!s_name, "الموظف") rsEmp.Close Set rsCtrl = db.OpenRecordset("SELECT TOP 1 * FROM tbl_Ctrl") If rsCtrl.EOF Then MsgBox "يرجى التحقق وضبط اعدادات التحكم", vbCritical + vbMsgBoxRight, "" Exit Sub End If waitBetween = Nz(rsCtrl!waitBtween, 1) allowedBefore = Nz(rsCtrl!timeBefore, 0) allowedAfter = Nz(rsCtrl!timeAfter, 0) rsCtrl.Close shiftId = "0" periodName = "غير محددة" Set rsShift = db.OpenRecordset("SELECT * FROM tbl_Ftrat") Do While Not rsShift.EOF startWork = DateAdd("n", -allowedBefore, rsShift!start_work) endWork = DateAdd("n", allowedAfter, rsShift!end_work) If currentTime >= TimeValue(startWork) And currentTime <= TimeValue(endWork) Then shiftId = CStr(rsShift!id) periodName = rsShift!ftraName Exit Do End If rsShift.MoveNext Loop rsShift.Close '------------------------- ( في حال أردنا التخصيص ) '' If shiftId = "0" Then '' MsgBox "لا توجد فترة مناسبة للوقت الحالي ، لا يمكن تسجيل التوقيع", vbExclamation + vbMsgBoxRight, "" '' Exit Sub '' End If '------------------------- sql = "SELECT TOP 1 chekInOut FROM tblcomIn WHERE UserId = '" & UserId & "' ORDER BY chekInOut DESC" Set rsLastMove = db.OpenRecordset(sql) If Not rsLastMove.EOF Then lastTime = rsLastMove!chekInOut If DateDiff("s", lastTime, Now) < (waitBetween * 60) Then MsgBox "لا يمكنك التوقيع مرتين خلال أقل من " & waitBetween & " دقيقة", vbExclamation + vbMsgBoxRight, "" rsLastMove.Close Exit Sub End If End If rsLastMove.Close sql = "SELECT TOP 1 chekType FROM tblcomIn WHERE UserId = '" & UserId & "' AND DateValue(chekInOut) = Date() AND FtraID = '" & shiftId & "' ORDER BY chekInOut DESC" Set rsLastMove = db.OpenRecordset(sql) If Not rsLastMove.EOF Then If rsLastMove!chekType = "1" Then checkType = "2" Else checkType = "1" End If Else checkType = "1" End If rsLastMove.Close sql = "INSERT INTO tblcomIn (UserId, chekInOut, chekType, FtraID) VALUES " & _ "('" & UserId & "', #" & Format(Now, "yyyy-mm-dd hh:nn:ss") & "#, '" & checkType & "', '" & shiftId & "')" db.Execute sql, dbFailOnError MsgBox "تم تسجيل " & IIf(checkType = "1", "الدخول", "الخروج") & vbCrLf & _ "الموظف: " & empName & vbCrLf & "الفترة: " & periodName, vbInformation + vbMsgBoxRight, "" Me.id = "" Me.id.SetFocus Exit Sub Err_Handler: MsgBox " : خطأ أثناء تنفيذ العملية" & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight, "" End Sub ملاحظة .. في الجزء :- shiftId = "0" periodName = "غير محددة" استخدمته لتهيئة متغيرين رئيسيين قبل الدخول في حلقة البحث عن الفترة الحالية المناسبة ( tbl_Ftrat ) . حيث أن القيمة ( 0 ) هنا تعني مبدئياً : ( لا توجد فترة مناسبة تم تحديدها بعد ) . وطبعاً سيتم تعيين قيمة فعلية له لاحقاً من الجدول tbl_Ftrat عندما يطابق الوقت الحالي فترة ما داخل الجدول . من خلال الجملة :- If currentTime >= TimeValue(startWork) And currentTime <= TimeValue(endWork) Then shiftId = CStr(rsShift!id) بحيث إذا وجد وقت يطابق الفترة ، يتم تعيين رقم الفترة الحقيقي . وكذلك الأمر فيما يتعلق بـ "غير محددة" .... والهدف كان في فكري ، للتحكم في الحالات غير المتوقعة :- فإذا لم يعثر على فترة مناسبة ضمن الوقت والسماح ، تبقى القيم الافتراضية ( 0 و غير محددة ) . ولتسجيل التوقيع حتى في حال عدم المطابقة . في بعض الحالات ، قد ترغب بتسجيل التوقيع رغم عدم انطباقه على أي فترة . ( من باب الإحتياط ) وطبعاً قابل لتخصيصه كجزء شرطي . فمثلاً إذا أردت منع التوقيع تماماً في حالة عدم مطابقة أي فترة ، يمكن وضع شرط كالآتي في نهاية حلقة البحث :- Loop rsShift.Close If shiftId = "0" Then MsgBox "لا توجد فترة مناسبة للوقت الحالي ، لا يمكن تسجيل التوقيع", vbExclamation + vbMsgBoxRight, "" Exit Sub End If وطبعاً سيتم إلغاء التسجيل وعدم تنفيذ باقي الكود !!! وطبعاً وجب التذكير بأنني أخذت على عاتقي تعديل منطق احتساب وقت الانتظار بين التوقيعين ليكون مقروناً ومشروطاً بالموظف الحالي فقط . يعني لو أردنا الانتظار دقيقة لتسجيل الحضور لـ 20 موظف على سبيل المثال !! فهذا يعني أن آخر موظف سيكون متأخراً 20 دقيقة هههههههه حسب الوقت الذي سيتم تسجيله له ( صحيح ) ، ولذا ألزمت التحقق من فترة الانتظار برقم الموظف . فكرتي المتواضعة .. comOutDb2.zip

وعليكم السلام ورحمة الله وبركاته ،، موضوع ثري وجميل للنقاش ، ويستحق فعلاً أن يُبنى على تصور شامل ودقيق من البداية . وبحسب ما فهمت من تصوركم – وهو تصور متطور ومرن – لدي نقطة بسيطة أحب أن أطرحها للنقاش :- هل سيُؤخذ بعين الاعتبار مسألة ( التأخيرات المسموحة ) ؟ يعني مثلاً :- إذا تأخر الموظف عن وقت حضوره بـ 5 دقائق ، هل يُعتبر (حاضراً ضمن الوقت أم متأخراً ) ؟؟؟؟ لهذا أعتقد أنه من المفيد – وربما الضروري 😅 – أن تكون هناك حقول مثل :- StartTime و EndTime لكل وردية . وحقل إضافي مثل AllowedDelayMinutes ( الحد الأقصى للتأخير المقبول ) . هذا يُسهل مستقبلاً حساب التأخير والانصراف المبكر ، ويجعل النظام أكثر دقة وواقعية ، خاصة إذا تم استخدام البيانات لاحقاً في تقييم الأداء أو إعداد تقارير زمنية . مجرد وجهة نظر قابلة للنقاش 🌷 ، ومتابع معكم للإستفادة من الآراء والتجارب . وهو فعلاً ما تم إدراجه في مرفق معلمنا أبو خليل ، ولكن جاء ردي قبل أن أرى المرفق في آخر مشاركة له 👌 وبناءً على الملف المرفق ، قمت بإضافة حقل جديد نصي = "FtraID" ، في الجدول "tblcomIn" ، وقيمته يتكون رقم الفترة التي سجل فيها الموظف حضور أو انصراف . وتم اعتماد القيم ( 1 = حضور ، 2 = انصراف ، 3 = حضور متأخر ) في الحقل chekType داخل نفس الجدول . بحيث نعالج :- التأكد من إدخال رقم الموظف وعدم تركه فارغاً . التحقق من وجود الموظف في جدول الموظفين tblNames . تحديد الفترة الزمنية المناسبة (الفترة الحالية) حسب الوقت الآن من حقول start_work وend_work في جدول الفترات tbl_Ftrat . إذا لم تكن الفترة الحالية ضمن أي فترة معرفة ، يتم تسجيل حركة دخول متأخر ( chekType = 3 ) . إذا كانت الفترة الحالية معروفة :- * حساب عدد حركات الدخول ( chekType = 1 أو 3 ) والخروج ( chekType = 2 ) للموظف في نفس الفترة واليوم الحالي. * منع تسجيل دخول جديد في نفس الفترة واليوم إذا كان الموظف قد أكمل دورة دخول وخروج ( أي أن عدد الدخول أقل أو يساوي عدد الخروج ) . * تحديد نوع الحركة القادمة ( دخول أو خروج ) حسب آخر حركة مسجلة للموظف في نفس الفترة واليوم . * تسجيل الحركة الجديدة (دخول ، خروج ، أو دخول متأخر) في جدول tblcomIn مع ربطها بالفترة . * إعلام المستخدم برسالة تأكيد نوع الحركة والفترة . وهذا ملف التعديل ، لإجراءاتكم بالنتيجة اذا كانت غير مطابقة أو يوجد احتمالات لم تخطر لي حالياً .. comOutDb.zip

السبب هو أنه يوجد خلايا مدمجة ، فكيف سيتم تمييز في اي خلية سيتم ادراج التاريخ و الوقت !!!!! قمت بتعديل مواضع الـ CheckBox في ملفك ، وتعديل الدالة بحيث تتعامل مع الخلايا المدمجة ، لتصبح كالتالي :- Sub FokshCheckBox() Dim chk As CheckBox Dim rng As Range Dim rowNum As Long, colNum As Long Dim targetCell As Range Dim cbValue As Long On Error GoTo SafeExit Set chk = ActiveSheet.CheckBoxes(Application.Caller) cbValue = chk.Value If chk.TopLeftCell Is Nothing Then Exit Sub Set rng = chk.TopLeftCell rowNum = rng.Row colNum = rng.Column Set targetCell = Cells(rowNum, colNum + 1) If targetCell.MergeCells Then Set targetCell = targetCell.MergeArea.Cells(1, 1) End If If cbValue = xlOn Then If IsEmpty(targetCell.Value) Then targetCell.Value = Now End If ElseIf cbValue = xlOff Then targetCell.MergeArea.ClearContents End If SafeExit: End Sub اختيار التاريخ.xlsm

بسيطة أخي الكريم ، الآن حسب ملفك المرفق ، جرب هذا التعديل :- Sub FokshCheckBox() Dim chk As CheckBox Dim rng As Range Dim rowNum As Long, colNum As Long Dim targetCell As Range On Error GoTo SafeExit Set chk = ActiveSheet.CheckBoxes(Application.Caller) If chk.TopLeftCell Is Nothing Then GoTo SafeExit Set rng = chk.TopLeftCell rowNum = rng.Row colNum = rng.Column Set targetCell = Cells(rowNum, colNum - 1) ' عدّل هنا : لتحديث الخلية اليمين = + 1 If chk.Value = xlOn Then If IsEmpty(targetCell.Value) Then targetCell.Value = Now End If ElseIf chk.Value = xlOff Then targetCell.ClearContents End If SafeExit: End Sub والتأكد من عدم وجود عناصر متشابهة في الإسم من الـ CheckBox ، وقم باستدعاء الماكرو لكل عنصر منهم .. * ملاحظة ، تستطيع التبديل بين الخلية اليمين أو اليسار التي سيتم عرض التاريخ و والوقت فيها على الملف كاملاً من خلال استبدال -1 بـ +1 فقط ، كما هو موضح في الكود . 222مربع اختيار يضيف التاريخ والوقت عند الاختيار.zip

نعم صحيح ، هي كفكرة حلوة وتتيح لك التوسع في طريقة وتنسيق عرض الساعة ، حتى أني استخدمتها في برنامج نظام الطابور لعرض الساعة باللغتين ( عربي و انجليزي ) من خلال النقر على الساعة نفسها 😅

وعليكم السلام ورحمة الله وبركاته ,,, بعد عدة محاولات من خلال المعادلات ، وجدت أنه من الصعب عدم تحديث الخلايا الغير معنية بالإدراج ، لذا توجهت الى استخدام الماكرو التالي :- Sub FokshCheckBox() Dim chk As CheckBox Dim rng As Range Dim rowNum As Long For Each chk In ActiveSheet.CheckBoxes Set rng = chk.TopLeftCell rowNum = rng.Row If chk.Value = xlOn Then If IsEmpty(Cells(rowNum, "A").Value) Then Cells(rowNum, "A").Value = Now End If ElseIf chk.Value = xlOff Then Cells(rowNum, "A").ClearContents End If Next chk End Sub وعليه ، فيتم استدعائه في جميع الـ CheckBoxes التي لديك فقط ، دون ربط العناصر ببعضها .. ملفك بعد التعديل ، جرب وأخبرنا بالنتيجة مربع اختيار يضيف التاريخ والوقت عند الاختيار.zip

نفس الإستعلام الخاص بك ، ولكني استخدمت شرط الفلترة في حدث عند الفتح للتقرير ليتوافق مع شرط الفلترة في الاستعلام لتطابق النتائج بينهما .. Private Sub Report_Open(Cancel As Integer) If Not IsNull(Forms!search4!searchtext.Value) Then Me.Filter = "[id] & ' ' & [rank] & ' ' & [emp] & ' ' & [employer] & ' ' & [emp_id] & ' ' & [national id] & ' ' & [date of birth] & ' ' & [phone] & ' ' & [phone next] & ' ' & [address] & ' ' & [notes] & ' ' & [marital status] & ' ' & [promote to] & ' ' & [promote date] & ' ' & [transfer to] & ' ' & [transfer date] & ' ' & [membership no] & ' ' & [establishment fee] & ' ' & [monthly installment] & ' ' & [subscription date] & ' ' & [age at subscription] & ' ' & [subscription daration] & ' ' & [due date] & ' ' & [membrship type] & ' ' & [created_date] & ' ' & [user] & ' ' & [mostafed] & ' ' & [national id2] & ' ' & [phone2] & ' ' & [sabb] & ' ' & [tarekh] & ' ' & [shek] & ' ' & [mostfad mn alaml] LIKE '*" & Replace(Forms!search4!searchtext.Value, "'", "''") & "*'" Me.FilterOn = True Else Me.Filter = "" Me.FilterOn = False End If End Sub

هذه فكرة بسيطة .. Foksh.accdb

طيب تمام ، جرب هذه الفكرة السريعة ، وباعتقادي قد تجد أفكار أفضل 100% من الأخوة والأساتذة والمعلمين هنا .. الجمعية 29.zip

وعليكم السلام ورحمة الله وبركاته ,, من باب السؤال أخي الفاضل ، ماذا بعد أن يتم إضافة كلمة (الكل) الى الكومبوبوكسات ؟؟؟؟؟؟؟؟؟؟؟؟؟ اعلم أن من وراء هذا الطلب سيكون طلب آخر ، لذا آتنا به .

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

عايز 37 حقل في ورقة وحدة وبجنب بعض في صف واحد 😅 .. طب إزااااااي ؟؟

وإياكم أخي الكريم .. بارك الله فيك

وهذا هو المطلوب أخي الكريم .. شكراً لك ، ولكم من الدعاء النصيب الأكبر بإذن الله .

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

بارك الله بك ، ونفع بك ,, أشكرك أخي ناقل على تهنئتك

مداخلة فيما يتعلق بإعدادات اللغة الإقليمية في الويندوز ,, اذا كان الويندوز لديك إصدار 10 أو 11 ، فجرب اقرأ ها الموضوع ، عله يكون مفيداً لك .. الإصدار الأخير من الأداة في هذه المشاركة هنا ..

وعليكم السلام ورحمة الله وبركاته .. رغم أنك الى حد ما قريب من تحقيق هدفك في محاولتك داخل الزر .. إلا ان بعض النقاط قد غابت عنك ، مثل :- تنسيق التاريخ بشكل صحيح . استخدام دالة DLookup بطريقة سليمة عند مقارنة التواريخ . يفضل استخدام Format عند التعامل مع التواريخ في SQL لتفادي أخطاء اللغة الإقليمية وتنسيق التواريخ . على العموم ، جرب هذا التعديل على ملفك الصلي إن كان صحيحاً :- Private Sub أمر24_Click() Dim numFonct As Long Dim dateGrade As Date Dim critereRecherche As String Dim resultat As Variant numFonct = Nz(Me!num, 0) dateGrade = Nz(Me!date_grade_poste_actuel, #1/1/2000#) critereRecherche = "code_fonct = " & numFonct & " AND date_nomination = #" & Format(dateGrade, "yyyy-mm-dd") & "#" resultat = DLookup("code_fonct", "tbl_masser_mihani", critereRecherche) If Not IsNull(resultat) Then MsgBox "هذه المعلومات موجودة من قبل", vbExclamation + vbMsgBoxRight, "" Exit Sub End If DoCmd.SetWarnings False DoCmd.RunSQL _ "INSERT INTO tbl_masser_mihani (code_fonct, loi_fondamontale, grade, sinf, date_nomination, numero_visa_cf, date_visa_cf) " & _ "SELECT num_fonctionnaire, loi_fondamontale, grade_poste_actuel, categorie, date_grade_poste_actuel, num_visa_grade_poste_actuel, date_visa_grade_poste_actuel " & _ "FROM tbl_info_fonctionnaire " & _ "WHERE num_fonctionnaire = " & numFonct DoCmd.SetWarnings True MsgBox "تمت الإضافة بنجاح", vbInformation + vbMsgBoxRight, "نجاح" End Sub

اخي افتح المرفق التالي ، واختر فلترة عشوائية لأي بيانات ، وانقر زر افتح التقرير .. الترتيب والتصميم حسب رغبتك . ما تم هو انشاء تقرير مبني على الإستعلام Qsearch4 ، وإضافة الحقول نفسها من الاستعلام الى التقرير .. حيث ان الاستعلام مشروط بالفلترة ، وما سيتم تطبيقه على التقرير هو عرض السجلات التي تم فلترتها فقط الجمعية 28.zip

أهلاً باشمهندس @عمر ضاحى ،، جميع ما ذكرته تقريباً ، هو ما تم التلميح له سابقاً ، وقم تم إدراجه في التحديث الجديد.. أما إنشاء نسخة احتياطية Dat ، فهي تعمل بشكل سليم ، ولكن ما لم يكن مدرجاً هو الإستعادة من هذه الصيغة 😅 أما فيما يخص فأعتقد أن الأزرار والعناوين واضحة بشكل كافي ، ولكن أعتقد أيضاً أن كثيرة هي المواضيع التي تناولت موضوع النسخ الاحتياطي وبنفس النمط 😅 ، مع محاولتي الإحتفاظ بالتسميات للأزرار دون تعديلها بإختصارات. بكل الأحوال يسعدني ويشرفني مرورك العطر 💐 💐

فهمتك معلمي الفاضل .. بالطبع ، ويمكن تقييد المستخدم العادي من عدم الدخول أساساً الى لوحة النسخ الإحتياطي ( وهذا لا خلاف عليه ) في الأداة جعلتها قادرة على التعامل مع القواعد المنقسمة والغير .. وإذا كان النسخ الإحتياطي الذي نريده ان يتم على القاعدة لجميع الجداول ( عند محاولة استرجاع طبعاً ) محصوراً فقط بالجداول المحلية ، فلا أعلم الهدف ( والسبب أن 99% ممن يقوم بتقسيم قواعد بياناته هو لتجنب تلف وتضخم قواعد البيانات بسرعة ولحمابة البيانات والجداول ) . على العموم سأرى ما يمكن تفعيله وتعديله في النسخة الجديدة ان شاء الله أهلا مهندسنا الغالي ,, في الواقع ، من المفترض أن يتم انشاء المجلدات عند فتح الواجهة ، ولكن يبدو أنني لم أعد استدعاء الدالة الى حدث عند الفتح ,, لذا تم التعديل لاحقاً في النسخة الجديدة ان شاء الله 👍 الإسترجاع في الإصدار السابق محصور فقط للـ MDB ، وقد التعديل والتطوير في الإصدار الجديد أيضاً .. لكني هنا في طور استنتاج النقاط التي يمكن إضافتها وتحسينها 😊

وعليكم السلام ورحمة الله وبركاته .. المعطيات من خلال الملف المرفق :- 1. نوع التنسيق = نسبة مئوية ( Percent ) . 2. النتيجة في المربعات النصية التي فيها المشكلة = #Num! دلالة على أنه غير قادر على إدراج النتيجة 0 كنسبة مئوية .. جرب في مربع النص d67 داخل ا لتقرير استخدام الجملة التالية :- =IIf([d55]=0,0,([d63]+[d61]+[d59])/[d55]) بدلاً من التعبير السابق :- =([d63]+[d61]+[d59])/[d55] وبناءً عليه قم بالتطبيق بنفس الأسلوب 🤗