اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

منع التعديل على بيانات تم إدخالها سابقا في نطاق محدد


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

الردود الموصى بها

  • أفضل إجابة

هذا الكود ربما يساعدك

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a, b, c
a = Not Intersect(Target, Union(Range("A2:A1000"), _
    Range("D2:D1000"))) Is Nothing
b = Target.Cells(1) <> vbNullString
c = Target.Count = 1
Application.EnableEvents = False
If a * b * c <> 0 Then
 Target.Offset(, 1).Select
End If
Application.EnableEvents = True
End Sub

 

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

بعد اذن استاذنا سليم , ولإثراء الموضوع يمكنك وضع هذه الأكواد فى حدث الصفحة

Dim mRg As Range
Dim mStr As String
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Range("A2:D1000"), Target) Is Nothing Then
    Set mRg = Target.Item(1)
    mStr = mRg.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    On Error Resume Next
    Set xRg = Intersect(Range("A2:D1000"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    If xRg.Value <> mStr Then xRg.Locked = True
    Target.Worksheet.Protect Password:="123"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("A2:D1000"), Target) Is Nothing Then
    Set mRg = Target.Item(1)
     mStr = mRg.Value
End If
End Sub

 

  • Like 3
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information