ماستر باسورد ماستر باسورد

[samycalls2020]

الفكرة هى استبدال الباس ورد فى كود للحمايه

الملف رئيسى باسم " control "

المطلوب .. استبدال الباس ورد 123 بالقيمة الموجوده فى الخليه A1 فى الورقة SS فى ملف " عملاء"

والملف " عملاء " وغيره مرتبطين بالملف الرئيسى  " control "

وخلية A1  فى الورقة  SS  فى ملف " عملاء "  تأخذ قيمتها من الملف الرئيسى  " control "

وبتغير الباس ورد قى ملف  " control " يتغير فى الخلية A1 فى الورقة SS فى ملف " عملاء"

وكذلك فى جميع الملفات الأخرى المرتبطة . فيكون باسورد رئيسى

هذا الكود يوضع فى كل الملفات

Sub AUTO_OPEN()
    MyPassword = "123"
For Each MySheet In ActiveWorkbook.Sheets
    MySheet.Protect _
        Password:=MyPassword, _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingColumns:=True, _
        AllowFiltering:=True, _
        AllowSorting:=True, _
        UserInterfaceOnly:=True
Next MySheet
End Sub

فهل يصلح هكذا
Sub AUTO_OPEN()
    MyPassword = Sheets("SS").Range("A1")
For Each MySheet In ActiveWorkbook.Sheets
    MySheet.Protect _
        Password:=MyPassword, _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingColumns:=True, _
        AllowFiltering:=True, _
        AllowSorting:=True, _
        UserInterfaceOnly:=True
Next MySheet
End Sub

 

تم تعديل أغسطس 15, 2017 بواسطه samycalls2020

[أ / محمد صالح]

التجربة خير دليل

جرب وأخبرنا بالنتيجة

رغم أنه لا يوجد ما يمنع تنفيذها نظريا

[samycalls2020]

للرفع

أرجوا المساعدة أخى الكريم / ياسر

[samycalls2020]

السلام عليكم

الكود يعمل ولكن عند فتح الملف تظهر رسالة كما فى الصورة 

وبالضغط على END تختفى الرسالة وتجد أن الكود يعمل

* هل من المكن جعل هذه الرسالة لاتظهر .. أو اصلاح الخظأ بالكود

الرجاء المساعده أيها الأخوة .. كم ناديت .. ولا مجيب .. 

إن الله في عون العبد ما دام العبد في عون أخيه

 

Sub AUTO_OPEN()
    MyPassword = Sheets("SS").Range("A1")
For Each MySheet In ActiveWorkbook.Sheets
    MySheet.Protect _
        Password:=MyPassword, _
        DrawingObjects:=True, _
        Contents:=True, _
        Scenarios:=True, _
        AllowFormattingColumns:=True, _
        AllowFiltering:=True, _
        AllowSorting:=True, _
        UserInterfaceOnly:=True
Next MySheet
End Sub

 

عملاء.rar

[ياسر خليل أبو البراء]

13 ساعات مضت, samycalls2020 said:

للرفع

أرجوا المساعدة أخى الكريم / ياسر

أخي الكريم تأكد أنه لو لدي علم بالأمر ما ترددت في المشاركة ويمكنك الإطلاع على موضوعات المنتدى وستجدني مشارك في الكثير منها .. ولكن فوق كل ذي علمٍ عليم

 

جرب تضع هذا السطر في بداية الكود

On Error Resume Next

[samycalls2020]

أعزك الله على تواضعك وحسن خلقك وجميل ردك .. أخى الفاضل / ياسر

[samycalls2020]

27 دقائق مضت, ياسر خليل أبو البراء said:

جرب تضع هذا السطر في بداية الكود

On Error Resume Next

بفضل الله .. وبمساعدة أخونا الكريم ياسر .. أعتقد أنه تم عمل الماستر باسورد

وأن أراد أحد المشاركة بفكرة أو رأى فمرحباً به ..

ماستر باسورد.rar