مطلوب تعديل على كود حماية اى خلية بها معادلات (Enable Filter - Sort)

[عاشق الاكسيل]

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

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

Sub lockCells()
Application.EnableEvents = False
Dim X As Worksheet
For Each X In ThisWorkbook.Worksheets
With X
     .Unprotect Password:="123"
     .Cells.Locked = False
                With .Cells.SpecialCells(-4123, 23)
                   .Locked = True
                   .FormulaHidden = True
                End With
   .Protect Password:="123", AllowFormattingCells:=True, AllowFiltering:=True, AllowSorting:= _
   True, DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
End With
Next X
Application.EnableEvents = True
End Sub

هذا الكود يقوم بعمل حماية على اى خلية تحتوى على معادلات مع تمكين المستخدم من تنسيق الخلايا والفرز والترتيب والفلترة

كل شىء يعمل جيدا عدا الفلترة فياريت التعديل عليه حتى يتيح فلترة البيانات

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

47 دقائق مضت, عاشق الاكسيل said:

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

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

Sub lockCells()
Application.EnableEvents = False
Dim X As Worksheet
For Each X In ThisWorkbook.Worksheets
With X
     .Unprotect Password:="123"
     .Cells.Locked = False
                With .Cells.SpecialCells(-4123, 23)
                   .Locked = True
                   .FormulaHidden = True
                End With
   .Protect Password:="123", AllowFormattingCells:=True, AllowFiltering:=True, AllowSorting:= _
   True, DrawingObjects:=True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
End With
Next X
Application.EnableEvents = True
End Sub

هذا الكود يقوم بعمل حماية على اى خلية تحتوى على معادلات مع تمكين المستخدم من تنسيق الخلايا والفرز والترتيب والفلترة

كل شىء يعمل جيدا عدا الفلترة فياريت التعديل عليه حتى يتيح فلترة البيانات

جرب هذا الكود /// يعمل من الخلية A1 حتى اخر خلية ضمن a1] .CurrentRegion]

Option Explicit

Sub lockCells()
Application.EnableEvents = False
Dim X As Range
    With ActiveSheet
          .Unprotect
          .Cells.Locked = False
          If .AutoFilterMode = False Then .[a1].CurrentRegion.AutoFilter
         Set X = .[a1].CurrentRegion.Cells.SpecialCells(-4123, 23)
                With X
                        .Locked = True
                        .FormulaHidden = True
                  End With
         ActiveSheet.Protect AllowFormattingCells:=True, AllowFiltering:=True, AllowSorting:= _
        True, Contents:=True, Scenarios:=True, userinterfaceonly:=True
    End With
Application.EnableEvents = True
End Sub

الملف مرفق

 

filter_ME.rar

[عاشق الاكسيل]

لم يعمل الكود بالشكل المطلوب

عند استخدامه يعطى رسالة خطا

No Cells Found

 

[عاشق الاكسيل]

سليم حاصبيا