اذهب الي المحتوي
أوفيسنا

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

  • تمت الإجابة
قام بنشر

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

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

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information