حماية المعادلات

[mahmoud3121983]

السلام عليكم ورحمة الله وبركاته اتمني من حضراتكم مساعدتي في حماية المعادلات بطريقة سريعة لان الاكواد والشيتات كثيرة والطريقة العادية لا تسعفني ... وارغب في اظهار رسالة عفوا لا تمتلك هذه الصلاحية عند محاةلة العبث باي معادلة ... واتمني التوضيح لاني ارغب في عملها بنفسي ..وجزاكم الله خيرا

 

 

[أبو سجده]

الاخ الفاضل // محمود

السلام عليكم

تابع الرابط التالى المشاركة رقم 4 و 14

http://www.officena.net/ib/index.php?showtopic=45743&page=1

تقبل وافر احترامى وتقديرى ... وجزاكم الله خيرا

[سليم حاصبيا]

 انسخ هذا الكود وصعه في حدث الصفحة:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim rng As Range
   For Each rng In Target.Cells
      If rng.HasFormula Then
         ActiveSheet.Protect
         Exit Sub
      Else
         ActiveSheet.Unprotect
      End If
   Next rng
End Sub

[mahmoud3121983]

الف شكراستاذي .... وجزاك الله كل خير .. واشكرك للاهتمام

[محمدي عبد السميع]

 

 انسخ هذا الكود وصعه في حدث الصفحة:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim rng As Range
   For Each rng In Target.Cells
      If rng.HasFormula Then
         ActiveSheet.Protect
         Exit Sub
      Else
         ActiveSheet.Unprotect
      End If
   Next rng
End Sub

الله يبارك فيك استاذ سليم حاصبيا

ويمدك بالصحة والعافيه

ويجعل الله أعمالك في كفة حسناتك

آمين .. يارب العالمين

[mahmoud3121983]

 

 انسخ هذا الكود وصعه في حدث الصفحة:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim rng As Range
   For Each rng In Target.Cells
      If rng.HasFormula Then
         ActiveSheet.Protect
         Exit Sub
      Else
         ActiveSheet.Unprotect
      End If
   Next rng
End Sub

اخي الفاضل عندما اضع الكود واننتقل للاكسيل .. واضغط علي ماكرو لاختار الماكرو واقوم بتشغيله لا يظهره الي وكلمة ران في المربع الحواري غير نشطة بالطبع لعدم وجود ماكرو .. هل سقط مني شيء لم افعله مع العلم اني قمت باتباع نفس لاخطوات في احدي فيديوهات اتعلم اونلاين .... وجزاك الله كل خير

[سليم حاصبيا]

لا حاجة لوضع زر 

الماكرو ينفذ نفسه بنفسه 

جرب ان تضع اية معادلة في الورقة ثم حاول ان تمسحها او تعدل عليها

[mahmoud3121983]

سؤال اخير استاذي الفاضل .. هل يمكن ادراج هذا الكود والرسالة التحذيرية لجميع المعادلات فقط دون تحديد للخلايا 

Private Sub Worksheet_Change(ByVal Target As Range)

If Me.[T1] Then Exit Sub
If Not Application.Intersect(Target, Range("c3:p10")) Is Nothing Then

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "عفوا ليس لديكم الصلاحية لاتمام هذا الاجراء"
End If
End sub

 

والف شكر لك مقدما وجزاك الله كل خير