منع التغير فى الخلايا واستثناء عدد5 صفحات

[abouelhassan]

الاخوة اساتذة المنتدى
احتاج ضبط هذا الكود الذى يمنع التغير فى نطاق معين من اوراق العمل ككل واستثناء 5 صفحات من التنفيذ

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i%

   For i = 5 To Sheets.Count
         If Sheets(i).Name <> "sheet3" Then

If Not Application.Intersect(Target, Range("a1:a1000")) Is Nothing Then
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
End If
Else
If Not Application.Intersect(Target, Range("a1:j5")) Is Nothing Then
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
       Next i
End With

End If
End If
End Sub

 

منع التغير فى الخلايا واستثناء عدد5 صفحات.xlsm

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

The Code

Option Explicit

 Private Sub Workbook_SheetChange _
 (ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = False
Dim Ar(4)

Ar(0) = "Sheet1": Ar(1) = "Sheet2"
Ar(2) = "Sheet3": Ar(3) = "Sheet4"
Ar(4) = "Sheet5"
  
  If IsError(Application.Match(Sh.Name, Ar, 0)) Then
       If Not Application.Intersect(Target, _
          Sh.Range("A1:J5")) Is Nothing Then _
          Application.Undo
       
  End If
 
 Application.EnableEvents = True
 
 End Sub

 

[abouelhassan]

تعجز الكلمات عن شكرك استاذى واخى

كل كلمات الشكر لايكفيك حقك

ربنا يحفظك ويرضى عنك

تسلم وتعيش يارب استاذى

الله يعزك

شكر وتقدير وخالص الاحترام من اخيك