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

[وائل الاسيوطي]

Sub ProtectSheetExceptRange()
' Protect ActiveSheet , but allow user edit Range("A1:A4,B1:D1")
' By Mokhtar 11/10/2015
    
  On Error Resume Next ' فى حالة حدوث خطأ تجاهله وانتقل للأمر التالى
  
  ' تحديد اسم الزر المشغل للكود فى حالة حماية الشيت النشط
  With ActiveSheet.Shapes("Rounded Rectangle 1").TextFrame2.TextRange.Characters
      If .Text = "Protect ActiveSheet Except" Then
         .Text = "UnProtect ActiveSheet "
           
         ' حذف النطاق الاول المسموح بالتعديل فيه فى الشيت
           ActiveSheet.Protection.AllowEditRanges(1).Delete
           
         ' تحديد اسم و مدى النطاق المراد التعديل فيه أثناء حماية الشيت
           ActiveSheet.Protection.AllowEditRanges.Add Title:="Protected Range", Range:=Range("A1:A4,B1:D1")
           
         ' فى حالة الرغبة فى حماية النطاق المراد التعديل عليه برقم سرى بخلاف الرقم السرى الخاص بحماية الشيت
         ' ActiveSheet.Protection.AllowEditRanges.Add Title:="Protected Range", Range:=Range("A1:A4,B1:D1"), Password:=123
           
         ' حماية الشيت  بدون كلمة سر
           ActiveSheet.Protect
         ' حماية الشيت بكلمة سر
         ' ActiveSheet.Protect Password:=123
           
         ' تعريف المستخدم بالنطاق المسموح بالتعديل فيه
           With ActiveSheet.Protection.AllowEditRanges.Item(1)
               MsgBox "ActiveSheet is Protecting" & vbNewLine & "Except Range : " & .Range.Address & vbNewLine & vbNewLine & "Regards ...Mokhtar "
           End With
            
           Else  ' اذا لم يكن هذا فان
                     
         '   فك حماية الشيت المحمى بدون كلمة سر
           ActiveSheet.Unprotect
         ' فى حالة فك حماية الشيت المحمى  بكلمة سر
         ' ActiveSheet.Unprotect Password:=123
         ' اسم الزر المشغل للكود فى حالة عدم حماية الشيت النشط
           .Text = "Protect ActiveSheet Except"
           
      End If
   End With
End Sub

الكود دا طبعا انتوا عارفين انه لاخي مختار الاسيووووووووووووطي

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

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

والصفحتين الاخرتين تكون محميتين بس معتمده علي خلايا معينه وليس مدي معين LOCK &UNLOCK

تفعيل الحمايه بمجرد فتح الملف واستعاده الحمايه بمجرد غلق الملف 

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

واعمل حسابك يااخي مختار ليك عندي عزومه حمام بعد كدا

[مختار حسين محمود]

أخى الفاضل وائل

اولا طبقا لتعليمات المنتدى برجاء عدم توجيه أى طلب الى شخص بعينه

فجميع الطلبات توجه الى الجميع ليشارك من يشارك فى الموضوع  وتوجيه أى طلبات بهذا الشكل يجعل الآخرون ينصرفون عن اجابة طلبك

ثانيا ضع طلبك فى مرفق تضع فيه كل طلباتك وتوقعاتك .         تحياتى

[وائل الاسيوطي]

أخى الفاضل وائل

اولا طبقا لتعليمات المنتدى برجاء عدم توجيه أى طلب الى شخص بعينه

فجميع الطلبات توجه الى الجميع ليشارك من يشارك فى الموضوع  وتوجيه أى طلبات بهذا الشكل يجعل الآخرون ينصرفون عن اجابة طلبك

ثانيا ضع طلبك فى مرفق تضع فيه كل طلباتك وتوقعاتك .         تحياتى

سلمت من كل شر 

حاضر اخي مختار 

حمايه.rar

[مختار حسين محمود]

أخى وائل  السلام عليكم

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

أخى وائل تم تحقيق طلبك فى موضوعى الجديد

حماية تلقائية للبيانات بكل أوراق العمل عدا نطاقات محددة قابلة للتعديل بكلمة سر

على الرابط

http://www.officena.net/ib/topic/64457-حماية-تلقائية-للبيانات-بكل-أوراق-العمل-عدا-نطاقات-محددة-قابلة-للتعديل-بكلمة-سر/

لكى تعم الفائدة على الجميع  تقبل تحياتى

[وائل الاسيوطي]

أخى وائل  السلام عليكم

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

أخى وائل تم تحقيق طلبك فى موضوعى الجديد

حماية تلقائية للبيانات بكل أوراق العمل عدا نطاقات محددة قابلة للتعديل بكلمة سر

على الرابط

http://www.officena.net/ib/topic/64457-حماية-تلقائية-للبيانات-بكل-أوراق-العمل-عدا-نطاقات-محددة-قابلة-للتعديل-بكلمة-سر/

لكى تعم الفائدة على الجميع  تقبل تحياتى

بارك الله فيك اخي مختار

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

فوجدت صدرا رحبا 

لك مني كل تحيه اخي عادل