Foksh

ما شاء الله ، مبدع فيما طرحت . أثار الموضوع اهتمامي سابقاً في مناقشة سابقة ومداخلة قوية لك ، مما جعلني أتحرى عن موضوع الحقن بشكل عميق وأحاول تنفيذه في مشاريعي تالياً .. ومن سياق الحديث الذي طرحته ، اعتقد أن استخدام المعلمات بدلاً من سلاسل نصية سيكون من خطوات الأمان التي قد يجب تنفيذها . أيضاً على ما أعتقد استخدامنا لمطهرات النصوص قد يأتي بنتيجة جيدة ومساعدة ,, على سبيل المثال ، هذه فكرة بسيطة أيضاً وقد تكون قابلة للتطوير والتحديث بشمولية ,, If InStr(Me.txtUser, "'") > 0 Or InStr(Me.txtUser, ";") > 0 Then MsgBox "تم استخدام رموز غير مسموح بها في اسم المستخدم", vbExclamation Exit Sub End If ولهذا السبب كنت قد استخدمت محاولة لم أقم بتجربتها بعد ، على أحد المشاريع باستخدام هذه الدالة :- Public Function Sanitizer(ByVal userInput As String, Optional ByVal context As String = "sql") As String Dim sanitized As String sanitized = Trim(userInput) Select Case LCase(context) Case "sql" sanitized = Replace(sanitized, "'", "''") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "--", "") Case "name" sanitized = Replace(sanitized, "'", "") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "*", "") sanitized = Replace(sanitized, "=", "") Case "pure" Case Else sanitized = Replace(sanitized, "'", "''") End Select Sanitizer = sanitized End Function وعلى سبيل المثال كإستخدام في الاستعلامات :- Dim filter As String filter = "[U_UserName]='" & Sanitizer(Me.txtUser, "sql") & "' AND [U_Password]='" & Sanitizer(Me.txtPass, "sql") & "'" DoCmd.OpenForm "frmDashboard", , , filter وكمثال على ما طرحته سابقاً لفتح نموذج بفلترة .. DoCmd.ApplyFilter , "[U_UserName]='" & Sanitizer(Me.txtSearch, "sql") & "'" أو حتى في نموذج تسجيل الدخول لاسم المستخدم ، كانت المحاولة :- Dim newUser As String newUser = Sanitizer(Me.txtNewUser, "name") هذه كانت الفكرة التي خطرت لي ، ولكن لاحقاً قمت بتحديثها لإظهار رسالة تحذيرية تلقائية إذا تم رصد مدخل خطير أو محاولات حقن نصية 😁

وعليكم السلام ورحمة الله وبركاته .. في مرفقك ، الورقة "MD1 15-2020-16" موجودة في الأساس ، وأنت تريد ترحيل البيانات اليها مسبقاً ، ثم تريد انشاء نسخة من الورقة Main بنفس الاسم الموجود في الخلية B2 في Main صحيح !!!! وضحها اذا سمحت 😅

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :- Sub ExtractAbsentEmployees() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim targetDate As Date Dim dayNum As Integer Dim targetCol As Integer Dim lastRow As Long Dim i As Long Dim reportRow As Long Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي") wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents targetDate = wsReport.Range("C2").Value dayNum = Day(targetDate) targetCol = 3 + dayNum If targetCol < 4 Or targetCol > 34 Then MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation Exit Sub End If lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 5 For i = 4 To lastRow If wsMain.Cells(i, targetCol).Value = "غ" Then wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value wsReport.Cells(reportRow, 4).Value = targetDate reportRow = reportRow + 1 End If Next i If reportRow = 5 Then MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation End If End Sub وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :- Sub GenerateMonthlyAbsenceReport() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim startDate As Date, endDate As Date Dim currentDate As Date Dim dayNum As Integer, targetCol As Integer Dim lastRow As Long, reportRow As Long, i As Long Dim empName As String, empJob As String Dim dateList As String, dayList As String Dim dateCount As Integer Dim dayName As String Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري") If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, "" Exit Sub End If startDate = wsReport.Range("C2").Value endDate = wsReport.Range("C3").Value If startDate > endDate Then MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, "" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With wsReport .Range("A6:F" & .Rows.Count).ClearContents .Range("6:" & .Rows.Count).RowHeight = 15 End With lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 6 For i = 4 To lastRow empName = wsMain.Cells(i, 2).Value empJob = wsMain.Cells(i, 3).Value If empName = "" Then GoTo NextEmployee dateList = "" dayList = "" dateCount = 0 currentDate = startDate Do While currentDate <= endDate dayNum = Day(currentDate) targetCol = 3 + dayNum If targetCol >= 4 And targetCol <= 34 Then If wsMain.Cells(i, targetCol).Value = "غ" Then dayName = wsMain.Cells(2, targetCol).Value If dateList <> "" Then dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd") dayList = dayList & vbLf & dayName Else dateList = Format(currentDate, "yyyy-mm-dd") dayList = dayName End If dateCount = dateCount + 1 End If End If currentDate = DateAdd("d", 1, currentDate) Loop If dateCount > 0 Then With wsReport .Cells(reportRow, 1).Value = reportRow - 5 .Cells(reportRow, 2).Value = empName .Cells(reportRow, 3).Value = empJob .Cells(reportRow, 4).Value = dateCount .Cells(reportRow, 5).Value = dateList .Cells(reportRow, 6).Value = dayList .Cells(reportRow, 5).WrapText = True .Cells(reportRow, 6).WrapText = True If dateCount > 1 Then .Rows(reportRow).RowHeight = 15 * dateCount End If End With reportRow = reportRow + 1 End If NextEmployee: Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If reportRow > 6 Then ' MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, "" End If End Sub وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة .. موقف غياب موظفين.zip

تحويل الدالة الى دالة عامة ، يتم استدعائها في أي نموذج ، توسيع الفكرة اختيار التاريخ لا يعمل بشيت b-c-d.xlsm ملاحظة مهمة ، يجب ان يكون الـ CheckBox بجانب الخلية المستهدف إدرا الوقت والتاريخ فيها . أي على يسار الخلية وإذا كانت الخلية المستهدفة على اليسار ، نقوم باستبدال الجزء +1 الى -1 في الدالة داخل المديول

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

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

وعليكم السلام ورحمة الله وبركاته ,, حاولت فهم المطلوب بشكل واضح ، وخرجت بهذه الفكرة . حيث انشأت زر للتنفيذ ، يحتوي الكود التالي :- Private Sub Btn_1_Click() Dim wsMain As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long Dim i As Long Dim targetCol1 As String, targetCol2 As String Dim sourceCol1 As String, sourceCol2 As String Set wsMain = ThisWorkbook.Sheets("F") Dim targetSheetName As String targetSheetName = wsMain.Range("F6").Value On Error Resume Next Set wsTarget = ThisWorkbook.Sheets(targetSheetName) On Error GoTo 0 If wsTarget Is Nothing Then MsgBox " : الورقة المحددة غير موجودة" & targetSheetName, vbExclamation + vbMsgBoxRight, "" Exit Sub End If If wsMain.Range("G6").Value = "قوى" Then sourceCol1 = "L" sourceCol2 = "M" targetCol1 = "H" targetCol2 = "I" ElseIf wsMain.Range("G6").Value = "تامين" Then sourceCol1 = "O" sourceCol2 = "P" targetCol1 = "H" targetCol2 = "I" Else MsgBox "يجب اختيار 'قوى' أو 'تامين' في الخلية G6", vbExclamation + vbMsgBoxRight, "" Exit Sub End If wsMain.Range("H6:I" & wsMain.Rows.Count).ClearContents lastRow = wsTarget.Cells(wsTarget.Rows.Count, sourceCol1).End(xlUp).Row lastRow = Application.WorksheetFunction.Max(lastRow, wsTarget.Cells(wsTarget.Rows.Count, sourceCol2).End(xlUp).Row) For i = 6 To lastRow If wsTarget.Range(sourceCol1 & i).Value <> "" Then wsMain.Range(targetCol1 & (i - 0)).Value = wsTarget.Range(sourceCol1 & i).Value End If If wsTarget.Range(sourceCol2 & i).Value <> "" Then wsMain.Range(targetCol2 & (i - 0)).Value = wsTarget.Range(sourceCol2 & i).Value End If Next i MsgBox "تم نقل البيانات بنجاح", vbInformation + vbMsgBoxRight, "" End Sub جرب المرفق وأخبرنا بالنتيجة .. BB.zip

لهذا السؤال :- هذا سيعتمد على ما إذا كان لكل موظف فترة واحدة فقط يومياً ( ومن سياق الحديث السابق لا اعتقد ذلك !! ) ، فيكفي ربط الدالة بمعرف الموظف فقط . أما إذا كان يمكن أن يسجل الموظف توقيعاً في أكثر من فترة (صباحي + مسائي) ، فهنا من الأفضل أن تأخذ الدالة أيضاً FtraID ( رقم الفترة ) لضمان دقة التحليل . والدالة الجميلة ، لي تعقيب واحد عليها . في السطر :- If minutes > 59 Then hours = hours + 1: minutes = 0 أرى أنه غير ضروري !! لأنه من المستحيل أن تكون minutes أكبر من 59 بسبب عملية Mod 60 السابقة !!!! أما فيما يخص الدالة ، فقط لأني سأخرج من العمل بعد قليل ، وسأحاول البدء بمشاركة بسيطة بأقرب فرصة .

قد يكون تنسيق الوقت !!! لكن انظر الوقت والتنفيذ الآن .. دعنا منها الآن .👍. طبعاً إذا كان لكل فترة وقت إتاحة مخصص ومختلف عن الفترة السابقة . أي لا نريد شمول الفترات جميعها بوقت إتاحة ثابت !! ومن هنا كل شيء سيكون عبارة عن بيانات وليس برمجة .. وهذه خطوة ذكية جداً أنك ستعتمد على حقول محسوبة .. وعلى سبيل المثال بهذا الشكل رح نعتمد على 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

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