مطلوب كودحمايه لجميع الشيتات

[ابراهيم الشال]

اخوانى 

مطلوب كودحمايه لجميع الشيتات من 1 حتى 31

مع استثناء الخلايا   الصفراء وذلك فى جميع  الشيتات

20.rar

[Mohammed Farid]

جرب الكود التالى أخى العزيز

Sub Protecting()
Dim WS As Worksheet
For Each WS In Worksheets
WS.Activate
For Each C In Range("A1:IV65536")
If C.Interior.ColorIndex <> 6 Then
C.Locked = True
C.FormulaHidden = True
End If
Next
ws.Protect Password:="AAA"

Next
End Sub

'هنا وضعت كلمة سر وهى "AAA" يمكنك أن تغيرها كما شئت

أو أن لا تضيف كلمة سر لحماية الورقة بأن تجعل الأمر  WS.Protect

تم تعديل مايو 1, 2013 بواسطه Mohammed Farid

[طارق محمود]

السلام عليكم

تفضل اخي هذا الكود

Sub Macro1()
On Error Resume Next
    For i = 1 To Sheets.Count
        Sheets(i).Select
        [B7:I7].Locked = False
        ActiveSheet.Protect "11", True, True
    Next i
 Sheets(1).Select
End Sub

[طارق محمود]

عفوا أخي محمد فريد لم أر مشاركتك إلا بعد أن شاركت

 

بالمناسبة أخي أبوعلي ، كلمة السر 11

[ابراهيم الشال]

الاخ الافاضل محمد فريد

نشكر لكم مروركم الكريم  وعلى محاولتكم ولكن تم تجربة ولم يعمل معى  

[ابراهيم الشال]

الاخ الفاضل طارق محمود

مشكور على هذا الكود الرائع  والذى  ادى الغرض تماما   

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

   

تم تعديل مايو 1, 2013 بواسطه ابوعلى

[طارق محمود]

السلام عليكم

وهذا كود فك الحماية لجميع الشيتات

علي أساس أن كلمة السر هي 11

 

Sub Macro1()
On Error Resume Next
    For i = 1 To Sheets.Count
        Sheets(i).Select
        ActiveSheet.Unprotect ("11")
    Next i
 Sheets(1).Select
End Sub

[عادل ابوزيد]

الباشمهندس طارق

اكواد رائعة مثل شخصكم الكريم

[ابراهيم الشال]

الاستاذ طارق

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