حماية خلايا بدون حماية الشيت

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

الكثيرون لحماية الخلايا يستعملون حماية الشيت  (Protect Sheet) 

لكن  في نطاق معين (تختاره بواسطة الكود) كيف يمكن ان نستعمل الخلية مرة واحدة فقط
     بحيث لا يمكن مسحها ولا التعديل عليها   فيما بعد الا اذا تم توقيف الكود عن العمل  كل ذلك بدون ( Protect Sheet) 
 

  الكود

Option Explicit
 Dim Old_value
 Dim New_value

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Old_value = Target.Cells(1, 1).Value
 End Sub
'==============================================
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Final_Step
If Intersect(Target, Range("A1:F12")) Is Nothing Then GoTo Final_Step
   New_value = Target.Value
    If Old_value = "" And Target.Cells.Count > 1 Then
     Application.Undo
     GoTo Final_Step
    End If
     If Old_value = "" Then
      Target.Value = New_value
      Else
     Application.Undo
    End If
Final_Step:
 Application.EnableEvents = True
End Sub

الملف تحت التصّرف

 

Protect_without Protect.xlsm

[Ali Mohamed Ali]

أحسنت استاذ سليم بارك الله فيك وجعل الله هذا العمل فى ميزان حسناتك

وجعلك دائما زخرا لنا وافاض الله عليك من كرمه وزادك من علمه وادامك الله لنا دائما عونا فى هذا المنتدى الكريم ولا تحرمنا دائما من كرمك وطلاتك علينا جزاك الله كل خير

[علي بطيخ سالم]

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

[Hamdi Edlbi-khalf]

أغبطك على معرفتك ... بارك الله بك

ملف مميز و  لكن لدى التجربة

تبين أن إعادة الكتابة أو مسح محتويات الخلية لمرتين  يسمح بالتعديل .

 

 

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

2 ساعات مضت, Khalf said:

أغبطك على معرفتك ... بارك الله بك

ملف مميز و  لكن لدى التجربة

تبين أن إعادة الكتابة أو مسح محتويات الخلية لمرتين  يسمح بالتعديل .

 

 

تم التعديل على الكود لمنع هذا الشي

Option Explicit
 Dim Old_value
 Dim New_value

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Old_value = Target.Cells(1, 1).Value
 End Sub
'==============================================
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Final_Step
If Intersect(Target, Range("A1:F12")) Is Nothing Then GoTo Final_Step
   New_value = Target.Value
    If Target.Cells.Count > 1 Then
      Application.Undo
     GoTo Final_Step
    End If
    If Old_value = "" And Target.Cells.Count > 1 Then
     Application.Undo
     GoTo Final_Step
    End If
     If Old_value = "" Then
      Target.Value = New_value
      Else
     Application.Undo
    End If
Final_Step:
 Application.EnableEvents = True
End Sub

 

[المتدرب]

السلام عليكم 

عند إعادة الكتابة مرتين يبدل المحتوى مع الشكر

[Hamdi Edlbi-khalf]

لا تزال المشكلة قائمة بالرغم من استبدال الأمر في الملف .

 

 

 

 

تم تعديل سبتمبر 28, 2018 بواسطه Khalf

[مازن امام]

يعطيك العافية على مجهودك الرائع

ولكن وجدت ثغرة اثناء تجربة الملف وهي من الممكن حذف محتويات الخلية بالطرية التالية:

1 تحديد الخلية

2 الضغط على مفتاح Backspace

3 ثم الضغط على Delete

4 الضغط على Enter

5 ثم الضغط على Delete مرة اخرى 

Protect_without Protect.xlsm

[عاطف عبد العليم محمد]

السلام عليكم 

ممكن استاذ سليم نجعل التغيير مفتوح لخلايا محددة والباقي كما موجود لا يسمح بالتغيير ؟

[abo_moaz]

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