كود لايعمل مع الحمايه

[ناصر سعيد]

الاخوة الاحباب

هذا كود يعمل جيدا ولكن مع اضافته في ملف به حمايه لايعمل

رجاء .. اريده يعمل وكل عام وانتم بخير

فلترة متقدمة.zip

[عبدالسلام ابوالعوافي]

ActiveSheet.Unprotect "123"
ActiveSheet.Protect "123"

السطر الاول في بداية الكود والسطر الثاني في اخر الكود ... 123 هي كلمة السر

[ناصر سعيد]

ActiveSheet.Unprotect "123"
Const StudentData As String = "بيانات الطلبة"
Const TopStudents As String = "الاوائل"

Private Sub Worksheet_Activate()

Application.DisplayAlerts = False
Sheets(TopStudents).Range("S:S").ClearContents

Sheets(StudentData).Range("V5:V212").AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheets(TopStudents).Range("S8"), unique:=True
Sheets(TopStudents).Range("S9").Value = "الكل"

With Sheets(TopStudents).Range("S8")
        .Interior.Pattern = xlSolid
        .Interior.Color = 65535
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Font.Size = 16
End With

With Sheets(TopStudents).Range("S9:S100")
        .Interior.Pattern = xlSolid
        .Interior.ColorIndex = 0
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Font.ColorIndex = 0
        .Font.Size = 16
End With


Application.DisplayAlerts = True
ActiveSheet.Protect "123"
End Sub

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

[ابو عبدالبارى]

Const StudentData As String = "ÈíÇäÇÊ ÇáØáÈÉ"
Const TopStudents As String = "ÇáÇæÇÆá"

Private Sub Worksheet_Activate()

ActiveSheet.Unprotect "123"

Application.DisplayAlerts = False
Sheets(TopStudents).Range("S:S").ClearContents

Sheets(StudentData).Range("V5:V212").AdvancedFilter Action:=xlFilterCopy, copytorange:=Sheets(TopStudents).Range("S8"), unique:=True
Sheets(TopStudents).Range("S9").Value = "Çáßá"

With Sheets(TopStudents).Range("S8")
        .Interior.Pattern = xlSolid
        .Interior.Color = 65535
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Font.Size = 16
End With

With Sheets(TopStudents).Range("S9:S100")
        .Interior.Pattern = xlSolid
        .Interior.ColorIndex = 0
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Font.ColorIndex = 0
        .Font.Size = 16
End With


Application.DisplayAlerts = True
ActiveSheet.Protect "123"
End Sub

اخى الكريم ناصر سعيد

ضعها فى هذا المكان

[عبدالسلام ابوالعوافي]

بداية السب ورتين وليس بداية الموديول كما وضح اخونا ابوعبدالباري جزاه الله خير