منع المستخدم من فك حماية الشيت

[أبوعيد]

السلام عليكم

هذا الكود يمكن ان أسميه فخ أو لغم

من المعلوم أن هناك برامج لفك حماية الشيتات لا نستطيع مقاومتها أومنعها من كسر الحماية

والمستخدم يقوم بكسر حماية الشيت للحصول على المعلومات السرية داخل البرنامج (معادلات ـ أعمدة مخفية .....الخ)

إذا منعنا المستخدم من الحصول على هذه المعلومات السرية فنكون قد حققنا الهدف

يبدأ عمل الكود من  حدث الصفحة  SELLECTION CHANGE ثم ينتقل إلى الإجراء booom

وهو يقوم بحذف أوراق محددة عندما يتم فك حماية الورقة (الشيت) والنقر على أي خليه فيها

ولكن انتبه : فيمكن أن يكون المبرمج نفسه هو ضحية لهذا الكود

(كما حصل لي شخصيا أثناء العمل على هذا المرفق)

إذا عاود المبرمج فك حماية الصفحة لتعديل أي معادلة مثلا وتحديد أي خلية سينفجر اللغم وتحذف الأوراق تلقائيا ويقفل البرنامج

لذا بعد الانتهاء من عمل أي برنامج وبعد حماية الصفحات يتم وضع هذا الكود

فإذا اراد المبرمج في وقت لاحق فك الحماية على الصفحة للتعديل عليها فيجب قبل ذلك الذهاب لمحرر الفيجوال والدخول على الماكرو booom  وتعليق السطر  الآتي

' Sheets(Array(1, 3, 4)).Delete

 

لأنه المسؤول عن حذف الأوراق (الأولى والثالثة والرابعة)

تفضلوا المرفق والشرح داخل الكود

abo eed file.rar

[عبد العزيز البسكري]

بارك الله فيك .. جزاك الله خيرًا وزادها بميزان حسناتك

[أبوعيد]

آمين وأنت كذلك

الأخ عبدالعزيز أسعدني مرورك

تحياتي لك ولأهل بسكرة

ألف شكر

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

بسم الله ما شاء الله تبارك الله

روعة أخي الحبيب أبو عيد .. والله وحشتني هداياك ..

ممكن إضافة بسيطة جداً ..

بدل أن تضع كود في حدث كل ورقة عمل يمكن وضع كود واحد فقط بجانب كود الموديول بالطبع

الكود يوضع في حدث المصنف ويتم حذف الأكواد الأخرى في أوراق العمل جميعها

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error GoTo 1
    'إذا كانت الصفحة محمية سيظهر خطأ في هذا الإجراء وعند ظهور الخطأ اذهب للرقم 1 بمعنى أنهاء العملية
    Range("XFD1") = "x"
    ' وضع إكس في الخلية لإحداث تغيير يتناسب مع حدث الصفحة
    If Intersect(Target, Range("XFD1")) Is Nothing Then
        ' إذا حصل التغيير في الخلية المحددة (وبدون أن أحددها) نفذ ما يأتي
        Call booom
        'شغل هذا الماكرو من الموديول
    End If
1:

End Sub

تقبل وافر تقديري واحترامي

[أبوعيد]

أخي ياسر , شكرا على الإضافة الجميلة التي أضفتها على الكود 

رائع جدا ويخدم المطلوب

والمجال مفتوح للأخوة الأعضاء لإضافة ما يرونه مناسبا 

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

هذا السطر  

Range("XFD1") = "x"

مع أنه بسيط ولكنه القشة التي قصمت ظهر البعير

بارك الله فيك

كن ذا همة تصل للقمة

تم التعديل على الملف

abo eed file1.rar

[محمد الزريعي]

هذا يقوم بحذف الشيتات وأيضاً الفورم والمديول ماعدا مديول التي فيها الكود ..

 

 

الكود مكتوب تمام .. لكن في التنفيذ لا يقوم بحفظ ما تم حذفة .

نرجوا المراجعة .. لو تكرمتم

 

_____boom 4.rar