طلب ماكرو لمنع الكتابة في خلية

[المسلم العربي]

السلام عليكم اخواني أرجو منكم افادتي 
لدي ملف به  خلية أريد أن تصبح ممنوعةمن الكتابة حسب قيمة الخلية التي قبلها لما تكون أكبر أو تساوي 10

الطلب موضح في الملف المرفق 

Demand Macro.rar

[سليم حاصبيا]

جرب هذا الملف

الماكرو مرفق

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 2 Or Target.Row < 2 Or Target.Cells.Count > 1 Then
Application.EnableEvents = True: Exit Sub
End If
ActiveSheet.Unprotect
    Cells(Target.Row, 3).Locked = False
       If IsNumeric(Target) And Target >= 10 Then
  Cells(Target.Row, 3).Locked = True
            ActiveSheet.Protect
      End If
Application.EnableEvents = True
End Sub

 

Demand Macro_salim.rar

[المسلم العربي]

شكرا سيدي أحتاج أن يحمي الخلية و يقوم بافراغها أيضا و شكرا لك سيدي و الصورة توضح لك الأعمدة كثيرة
 

[سليم حاصبيا]

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

جرب هذا الملف

الماكرو مرفق

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 2 Or Target.Row < 2 Or Target.Cells.Count > 1 Then
Application.EnableEvents = True: Exit Sub
End If
ActiveSheet.Unprotect
    Cells(Target.Row, 3).Locked = False
       If IsNumeric(Target) And Target >= 10 Then
  Cells(Target.Row, 3).Locked = True
            ActiveSheet.Protect
      End If
Application.EnableEvents = True
End Sub

 

Demand Macro_salim.rar

تم التعديل باضافة سطر واحد علة الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 2 Or Target.Row < 2 Or Target.Cells.Count > 1 Then
Application.EnableEvents = True: Exit Sub
End If
ActiveSheet.Unprotect
    Cells(Target.Row, 3).Locked = False
       If IsNumeric(Target) And Target >= 10 Then
       Cells(Target.Row, 3) = ""
       Cells(Target.Row, 3).Locked = True
            ActiveSheet.Protect
      End If
Application.EnableEvents = True
End Sub

 

[المسلم العربي]

شكرا لك سيدي و اخر سؤال كيف اطبق هذه العملية على اعمدة مختلفة و شكرا جزيلا

[سليم حاصبيا]

8 ساعات مضت, المسلم العربي said:

شكرا لك سيدي و اخر سؤال كيف اطبق هذه العملية على اعمدة مختلفة و شكرا جزيلا

حدد اي اعمدة تريد العمل عليها

[المسلم العربي]

الأعمدة الملونة باللون الأزرق سيدي و شكرا جزيلاً بارك الله فيك
 

[سليم حاصبيا]

15 ساعات مضت, المسلم العربي said:

شكرا لك سيدي و اخر سؤال كيف اطبق هذه العملية على اعمدة مختلفة و شكرا جزيلا

حدد اي اعمدة تريد العمل عليها

الكود المطلوب

6 دقائق مضت, سليم حاصبيا said:

حدد اي اعمدة تريد العمل عليها

الكود المطلوب

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column < 7 Or Target.Column > 29 _
Or Target.Row < 2 Or Target.Cells.Count > 1 _
Or Target.Column Mod 2 = 0 Then
Application.EnableEvents = True: Exit Sub
End If
ActiveSheet.Unprotect
    Cells(Target.Row, Target.Column + 1).Locked = False
       If IsNumeric(Target) And Target >= 10 Then
       Cells(Target.Row, Target.Column + 1) = ""
       Cells(Target.Row, Target.Column + 1).Locked = True
            ActiveSheet.Protect
      End If
Application.EnableEvents = True
End Sub