لدي مربع اختيار يضيف التاريخ والوقت ولكن للاسف يتغير كل مرة

[ابوعلي الحبيب]

السلام عليكم 

 

ياكرام 

لدي مربع اختيار  

يضيف التاريخ والوقت

عند اختيار 

ولكن للاسف يتغير عن الاختيار الاخر

يتغير الوقت والتاريخ كل مرة 

وانا اريدة ثابت عندما اقوم بختيارة 

ولا يتاثر عن الاختيار

 

وكذالك جربت طريقة ثانية ولم تنجح

مرفق صور المعادلة

الاخر امل المساعدة 

 

 

ولكم جزيل الشكر 

 

مرفق الملف

مربع اختيار يضيف التاريخ والوقت عند الاختيار.xlsm

تم تعديل بالامس في 21:02 بواسطه ابوعلي الحبيب

[Foksh]

4 ساعات مضت, ابوعلي الحبيب said:

السلام عليكم 

 

وعليكم السلام ورحمة الله وبركاته ,,,

بعد عدة محاولات من خلال المعادلات ، وجدت أنه من الصعب عدم تحديث الخلايا الغير معنية بالإدراج ، لذا توجهت الى استخدام الماكرو التالي :-

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

[ابوعلي الحبيب]

اشكرك استاذ Foksh

 اشكرك على التفاعل

ولكن المشكلة ان لدي خانات في اعمدة مختلفة 

وهو محدد ب عامود A فقط

وقد تم التعديل بالملف المرفق امل الاطلاع

جزاك الله خير 

222مربع اختيار يضيف التاريخ والوقت عند الاختيار.xlsm

[Foksh]

منذ ساعه, ابوعلي الحبيب said:

اشكرك استاذ Foksh

 اشكرك على التفاعل

ولكن المشكلة ان لدي خانات في اعمدة مختلفة 

وهو محدد ب عامود A فقط

وقد تم التعديل بالملف المرفق امل الاطلاع

جزاك الله خير 

222مربع اختيار يضيف التاريخ والوقت عند الاختيار.xlsm 43.18 kB · 1 download

بسيطة أخي الكريم ، الآن حسب ملفك المرفق ، جرب هذا التعديل :-

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

[ابوعلي الحبيب]

الأستاذ الفاضل Foksh

 ماشاء الله تبارك الله عليك 

 بالفعل هذا هو المطلوب

كل الشكر والتقدير لك

 

جزاك الله خير 

[ابوعلي الحبيب]

الأستاذ الفاضل Foksh

لماذا لم ينجح الحل

عندما نقلته الكود

 

امل الاطلاع 

مع الشكر والتقدير

 

اختيار التاريخ.xlsm

تم تعديل منذ 5 ساعات بواسطه ابوعلي الحبيب

[Foksh]

54 دقائق مضت, ابوعلي الحبيب said:

لماذا لم ينجح الحل

 

السبب هو أنه يوجد خلايا مدمجة ، فكيف سيتم تمييز في اي خلية سيتم ادراج التاريخ و الوقت !!!!!

قمت بتعديل مواضع الـ 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

[ابوعلي الحبيب]

أستاذي الفاضل /  Foksh 

اشكر لك سرعة تفاعلك

نعم هذا المطوب 

وجزاك الله خير