تحديد صلاحيات مختلفة لاكثر من مستخدم من يوزرفورم واحد دون اخفاء الشيتات

اذا كان لديك ملف اكسل يستخدمه اكثر من شخص واحد وتريد تحديد صلاحيات لكل مستخدم منهم على النحو التالى :
1- المستخدم الاول :
له كلمة سر واسم مستخدم محدد له ؛ وتريد صلاحياته الاتى 
القراءة والفلترة فقط ؛ فستستخدم الاكواد التالية بالطريقة المشروحة فى الفيديو :

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

2- المستخدم الثانى والثالث :
كل منهم له كلمة سر واسم مستخدم مختلفة على نفس الملف ولديهم صلاحية :
القراءة والفلترة وادخال البيانات وPIVOT TABLE
فستستخدم الاكواد التالية بنفس الطريقة المشروحة فى الفيديو :

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

الاكواد المستخدمة للملف كاملا والتى توضع فى الحدث ACTIVATE

Application.ScreenUpdating = False

Sheets("الادخال").Visible = True

Sheets("data1").Visible = True

Sheets("ســـــــولار").Visible = True

Sheets("Diesel Chart").Visible = True

Sheets("كارت الصنف").Visible = True

Sheets("طلبات الاحتياج").Visible = True

Sheets("حمالات و صرفيات").Visible = True

If Sheets("الادخال").Range("m2").Value = "Guest" And Sheets("الادخال").Range("m3").Value = "55555" Then

Sheets("الادخال").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Sheets("كارت الصنف").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

 Application.ScreenUpdating = False

Sheets("data1").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Application.ScreenUpdating = False

Sheets("ســـــــولار").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Application.ScreenUpdating = False

Sheets("Diesel Chart").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Application.ScreenUpdating = False

Sheets("حمالات و صرفيات").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Application.ScreenUpdating = False

Sheets("طلبات الاحتياج").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

Application.ScreenUpdating = False

 Sheets("الرئيسيه").Activate

 Application.ScreenUpdating = False

 End If

If Sheets("الادخال").Range("m2").Value = "A.kandil" And Sheets("الادخال").Range("m3").Value = "4444" Or Sheets("الادخال").Range("m2").Value = "M.sobhi" And Sheets("الادخال").Range("m3").Value = "1234" Then

Sheets("الادخال").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("كارت الصنف").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("data1").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("ســـــــولار").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("Diesel Chart").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

       , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("حمالات و صرفيات").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

       , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

Application.ScreenUpdating = False

Sheets("طلبات الاحتياج").Activate

    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

 Application.ScreenUpdating = False

 Sheets("الرئيسيه").Activate

 End If

لاحظ اختلاف اسماء الشيتات لديك واختلاف اسماء المستخدمين وكلمات المرور؛

الاكواد التالية توضع فى الحدث BEFORCLOSE فى اليوزرفورم فى زر نعم  بنفس الطريقة المشروحة فى الفيديو :

Sheets("الادخال").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("كارت الصنف").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("data1").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("ســـــــولار").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("Diesel Chart").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("حمالات و صرفيات").Activate

 ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

Sheets("طلبات الاحتياج").Activate

  ActiveSheet.Unprotect

    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _

        False, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:= _

        True

    ActiveSheet.EnableSelection = xlNoRestrictions

    Sheets("الرئيسيه").Select

ThisWorkbook.Save

UserForm2.Hide

لاحظ اختلاف اسماء الشيتات لديك 

فى الحدث ACTIVATE لكل ورقة من اوراق العمل اكتب الاكواد التالية :

If Sheets("الادخال").Range("m2").Value = "Guest" And Sheets("الادخال").Range("m3").Value = "55555" Then

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

        , AllowFiltering:=True, AllowUsingPivotTables:=True

    ActiveSheet.EnableSelection = xlNoSelection

   End If

If Sheets("الادخال").Range("m2").Value = "A.kandil" And Sheets("الادخال").Range("m3").Value = "4444" Or Sheets("الادخال").Range("m2").Value = "M.sobhi" And Sheets("الادخال").Range("m3").Value = "1234" Then

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _

      , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

End If

لاحظ اختلاف اسم الشيت لديك وخلية ادخال اسم المستخدم وكلمة المرور.

فى النهاية اذا صادفتك اية مشاكل يمكنك تركها فى تعليق .
ويمكنك التواصل معنا على صفحة لغة الاكسل ومجموعة لغة الاكسل على فيس بوك