منع الادخال في الحضور والانصراف الا عن طريق دبل كليك

[أبو قاسم]

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

جعل الادخال في الحضور والانصراف عن طريق دبل كليك فقط ولا يمكن الكتابة اليدوي

Book1.rar

[أبو قاسم]

جمعة مباركة على الجميع ....... هل من حل ان وجد ..... وجزاكم الله خير

[أبو قاسم]

مساء الخير هل من اجابة من الاخوة الاعزاء 

[ياسر خليل أبو البراء]

وعليكم السلام

جرب الكود التالي في حدث ورقة العمل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row > 8 Then
        If Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then
            Cancel = True
            Target.Value = Format(Time, "hh:mm")
        End If
    End If
End Sub

 

[أ / محمد صالح]

في 4/30/2017 at 21:05, أبو قاسم said:

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

جعل الادخال في الحضور والانصراف عن طريق دبل كليك فقط ولا يمكن الكتابة اليدوي

Book1.rar

أخي الكريم أبو قاسم

الملف المرفق به كود لنفس الغرض

ويعمل بكفاءة ولكنه يحتاج فقط إلى إضافة كلمة مرور لفك حماية الشيت

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim MyRange As Range
Dim IntersectRange As Range
Set MyRange = Range("j9:j33,h9:h33,i9:i33")
Set IntersectRange = Intersect(Target, MyRange)
On Error GoTo SkipIt
If IntersectRange Is Nothing Then
Exit Sub
Else
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Target = Format(Time, "h:m")
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xllockedCells
End If
ActiveSheet.Unprotect
Rows("1:1").Select
SkipIt:
Exit Sub
Application.ScreenUpdating = True
End Sub

ويمكن اختصاره لهذا الكود مع إضافة كلمة مرور هي 123

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
Dim MyRange As Range
Dim IntersectRange As Range
Set MyRange = Range("j9:j33,h9:h33,i9:i33")
Set IntersectRange = Intersect(Target, MyRange)

If IntersectRange Is Nothing Then
Exit Sub
Else
Cancel = 1
ActiveSheet.Unprotect ("123")
Target = Format(Time, "hh:nn")
ActiveSheet.Protect ("123")
End If

Application.ScreenUpdating = True
End Sub

 

18 ساعات مضت, ياسر خليل أبو البراء said:

وعليكم السلام

جرب الكود التالي في حدث ورقة العمل

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row > 8 Then
        If Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then
            Cancel = True
            Target.Value = Format(Time, "hh:mm")
        End If
    End If
End Sub

 

بارك الله لك أستاذ ياسر

كود ولا أروع ويمكن زيادة حماية الشيت بكلمة مرور (123) حتى يتحقق شرط الأخ صاحب السؤال 

الإدخال بدبل كلك فقط ولا يمكن التعديل اليدوي

ليصبح الكود مثلا

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row > 8 Then
        If Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then
            Cancel = True
            ActiveSheet.Unprotect ("123")
            Target.Value = Format(Time, "hh:mm")
            ActiveSheet.Protect ("123")
        End If
    End If
End Sub

كل عام والجميع بخير وسعادة

رمضان مبارك

[أبو قاسم]

رمضان كريم على الجميع  واشكركم جزيل الشكر والعرفان لاتسعني الكلمات التي اقولها ولكن نقول جزاكم الله عنا الف خير مع التحية