كود حمايه للخلايا في نطاق معين

[ehabaf2]

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

رجاء المساعدة فى تعديل الكود التالى لكي يعمل على الصفوف ارقام من 9 الى 21 فقط و باقى الشيت لا يشمله الكود

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect "45"
Target.Locked = True
ActiveSheet.Protect "45"
End Sub

مرفق ملف للتوضيح

شكرا جزيلا 
 

كود حماية.xlsm

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

جرب هذا

if Target.row >=9 and target.row <=22 then
....
End if

 

[علي بن علي]

جرب هذا الكود
يعمل على الصفوف من 9 إلى 21 فقط

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 9 And Target.Row <= 21 Then
ActiveSheet.Unprotect "45"
Target.Locked = True
ActiveSheet.Protect "45"
End If
End Sub

يعمل هذا الكود عن طريق التحقق من الصف الذي تم تغييره. إذا كان الصف يقع بين 9 و 21 ، فسيتم فك حماية الورقة وتأمين الخلية وإعادة تأمين الورقة. إذا لم يكن الصف يقع بين 9 و 21 ، فلن يتم فعل أي شيء

[ehabaf2]

الف الف شكر استاذنا الفاضل أ / محمد صالح

الف الف شكر استاذنا الفاضل أ / على بن على

تعديل الكود رائع و يعمل جيدا 

زادكم الله من فضله و علمه

 

السلام عليكم الاساتذة الافاضل

الف شكر على تعب حضراتكم

و اتوجه بالشكر للاستاذ الفاضل حسونه  حسين على تعبه و تنفيذ الكود بشكل احترافى زادكم الله من علمه و فضله

 

الاستاذ على بن على 

الف شكر لحضرتك لكن الكود يعمل تلقائى المطلوب عند الضغط على زر تشغيل يشتغل غير ذلك لا يعمل

[ehabaf2]

كود الاستاذ الفاضل حسونه حسين و هو ينفذ المطلوب بشكل احترافى

Option Explicit
Sub CClose()
    Dim Ws As Worksheet, RangeArea As Range, C As Range, MergedRange As Range
    kh_Application False
    Set Ws = ThisWorkbook.ActiveSheet
    With Ws
    Set RangeArea = .Range(.Cells(1, 1).Address, .Cells(653, IIf(ActiveCell.Column = 1, 1, ActiveCell.Column - 1)).Address)
    .Unprotect Password:="1"
    If ActiveCell.Row <= 653 Then
        For Each C In RangeArea
            If C.MergeCells = True And C.MergeArea.Rows.Count = 1 Then
                Set MergedRange = C.MergeArea
                MergedRange.UnMerge
                MergedRange.HorizontalAlignment = xlCenterAcrossSelection
            End If
        Next C
        RangeArea.Locked = True
    End If
    .Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    kh_Application True
End Sub

Sub COpen()
    kh_Application False
    ActiveSheet.Unprotect Password:="1"
    If ActiveCell.Row <= 653 Then
        Range(Cells(1, 1).Address, Cells(653, ActiveCell.Column).Address).Locked = False
    End If
    ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True
    kh_Application True
End Sub
Sub kh_Application(ibol As Boolean)
    With Application
        .ScreenUpdating = ibol
        .Calculation = IIf(ibol, -4105, -4135)
        .EnableEvents = ibol
    End With

End Sub

 

الف شكر استاذنا الفاضل حسونه حسين على تعبك و اهتمامك زادكم الله من فضله و علمه