حماية مع كود

[أبوحازم]

السلام عليكم . هذا ملف مرفق أريد به لو تكرمتم حماية الشيت ولكن الكود لا يعمل عند حماية الشيت ويظهر لي رساله أريد حماية بدون أي خطأ

2014.rar

[أبوحازم]

up

[طارق محمود]

السلام عليكم

أخي العزيز

أضف سطر لتفادي الخطأ في أول الكود 

On Error Resume Next
أضف بعده سطر لإلغاء الحماية

ActiveSheet.Unprotect

وسطر آخر لتفعيلها مرة أخري في آخر الكود 

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

 

سيكون الكود هكذا

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
ActiveSheet.Unprotect


     If Not Intersect(Target, Range("b1:b60000")) Is Nothing Then
      VBA.Calendar = vbCalGreg
      If IsEmpty(Target) Then
        Target(1, 2).Offset(0, -2).ClearContents
    Else
         With Target(1, 2).Offset(0, -2)
               .Value = Date
               .EntireColumn.AutoFit
           End With
       End If
End If
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
End Sub

[أبوحازم]

شكرا جزيلا جدا جدا يا أستاذ ( طارق محمود ) نعم هذا الذي أريدة