كود حماية

[فتحي محمد]

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

[عبدالله بشير عبدالله]

السلام عليكم ورحمكم الله

جرب الكود  كلمة السر 123

    
    Sub AdvancedProtectFormulas()
    Dim ws As Worksheet
    Set ws = ActiveSheet 
    
    On Error Resume Next
    ws.Unprotect "123"
    On Error GoTo 0
    
    Application.ScreenUpdating = False
    
    ws.Cells.Locked = False
    
    Dim formulaCell As Range
    For Each formulaCell In ws.UsedRange.SpecialCells(xlCellTypeFormulas)
        formulaCell.Locked = True
    Next formulaCell
    
    ws.Protect Password:="123", _
        AllowFiltering:=True, _
        AllowSorting:=True, _
        AllowFormattingCells:=False, _
        AllowFormattingColumns:=False, _
        AllowFormattingRows:=False, _
        AllowInsertingColumns:=False, _
        AllowInsertingRows:=False, _
        AllowInsertingHyperlinks:=False, _
        AllowDeletingColumns:=False, _
        AllowDeletingRows:=False, _
        AllowUsingPivotTables:=True, _
        DrawingObjects:=False, _
        Contents:=True, _
        Scenarios:=False, _
        UserInterfaceOnly:=True
    
    Application.ScreenUpdating = True
End Sub

كما يمكنك السماح ببعض الخصائص والشيت محمى من خلال التعديل في هذا الجزء TRUE او FALSE 

' حماية ورقة العمل بكلمة المرور "123"
ws.Protect Password:="123", _

    ' السماح بتصفية البيانات
    AllowFiltering:=True, _

    ' السماح بفرز البيانات
    AllowSorting:=True, _

    ' عدم السماح بتنسيق الخلايا (مثل تغيير الألوان أو الخط)
    AllowFormattingCells:=False, _

    ' عدم السماح بتنسيق الأعمدة (مثل تغيير العرض أو التنسيق)
    AllowFormattingColumns:=False, _

    ' عدم السماح بتنسيق الصفوف (مثل تغيير الارتفاع أو التنسيق)
    AllowFormattingRows:=False, _

    ' عدم السماح بإدراج أعمدة جديدة
    AllowInsertingColumns:=False, _

    ' عدم السماح بإدراج صفوف جديدة
    AllowInsertingRows:=False, _

    ' عدم السماح بإدراج روابط تشعبية (Hyperlinks)
    AllowInsertingHyperlinks:=False, _

    ' عدم السماح بحذف الأعمدة
    AllowDeletingColumns:=False, _

    ' عدم السماح بحذف الصفوف
    AllowDeletingRows:=False, _

    ' السماح باستخدام الجداول المحورية (Pivot Tables)
    AllowUsingPivotTables:=True, _

    ' عدم حماية الكائنات (مثل الأشكال أو المخططات)
    DrawingObjects:=False, _

    ' حماية محتوى الخلايا (لا يمكن تعديل القيم مباشرة)
    Contents:=True, _

    ' عدم حماية السيناريوهات (Scenarios)
    Scenarios:=False, _

    ' السماح للأكواد البرمجية (VBA) بالتعديل على الشيت حتى مع الحماية
    UserInterfaceOnly:=True
تحياني

 

 

تم تعديل أكتوبر 10 بواسطه عبدالله بشير عبدالله