كود لاخفاء واظهار الصفوف الملونة

[سماح الهياتمى]

ارجو من الاخوة الخبراء

عمل كود لاخفاء الصفوف الملونة

وكذا كود للاظهار

نسخة.rar

تم تعديل مارس 6, 2019 بواسطه سماح الهياتمى

[سماح الهياتمى]

برجاء الرد وشكرا لكم

[سماح الهياتمى]

للررررررررررررررررررررررررررررررررررفع

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

جرب هذا الملف

 

نسخة_salim.xlsm

[Ali Mohamed Ali]

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

[سماح الهياتمى]

شكرا اساتذتى على الرد ولكن زر  اخفاء واظهار الصفوف غير موجود برجاء اظهر االزر حتى اتمكن من الاخفاء والاظهار 

دى صورة من الملف اثناء فتحه وبعد عمل تمكين التحرير وتكبير الصفحة  يختفى زر الاظهار والاخفاء 

ارجو التعديل

تم تعديل مارس 6, 2019 بواسطه سماح الهياتمى

[سماح الهياتمى]

برجاء التعديل على الكود 

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

تم معالجة الامر

نسخة_salim sw.xlsm

[سماح الهياتمى]

شكرا لك استاذى على تعبك معى

ولكنى اريد عمل زر لاخفاء الصفوف عند النقر عليه يتم الاخفاء

وزر ايضا لاظهار الصفوف عند الضغط عليه يتم الاظهار

 

[سماح الهياتمى]

برجاء التعديل

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

تم التعديل

 

نسخة_salim version2.xlsm

[سماح الهياتمى]

شكرا استاذى العزيز على الملف الرائع 

لى رجاء اخير

ارجو تنفيذ الاكواد بنفس الشكل  الاخير على الملف المرفق وعدم المساس بتنسيقاته لانه مصمم على الطباعة

رجاءا  وشكرا لحضرتك

‫ايتام دار البر - نسخة.rar

[مصطفى محمود مصطفى]

بعد اذن الاستاذ سليم جزاه الله خيرا

اليك الملف بعد اضافة كود الاستاذ سليم وفقه الله

تحياتي

‫ايتام دار البر - نسخة.xlsm

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

زيادة في اثراء الموضوع هذا الكود(اسرع بكثير)

Option Explicit
Sub Hid_rows()
    With Application
     .ScreenUpdating = False
    End With
 Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1")
 With S_sh
    .Range("R1") = "تم"
     Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion
    .Range("m2").Formula = "=$J3<>$R$1"
     My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2")
    .Range("M2").ClearContents
    .Range("R1").ClearContents
End With
    With Application
     .ScreenUpdating = True
     .Calculation = xlCalculationAutomatic
    End With
End Sub
'=========================================
Sub SHOW_ALL()
On Error Resume Next
Sheets("ورقة1").ShowAllData
On Error GoTo 0
End Sub

الملف مرفق

ايتام دار البر by_adv_filter.xlsm

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

أو هذا مثلاً لاختيار اي شيء ( من القائمة في L2 المنسدلة لإخفائه)

في حال اضافة بيانات مختلفة عن "تم" او "-" في العامود J  يرجى تشغيل الماكرو  quelque chose   أولاً  للحصول على
     تحديث القائمة المنسدلة 

Option Explicit
Sub Hid_rows()
    With Application
     .ScreenUpdating = False
     .EnableEvents = False
    End With
    quelque_chose
 Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1")
 With S_sh

     Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion
    .Range("m2").Formula = "=$J3<>$L$2"
     My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2")
    .Range("M2").ClearContents

End With
    With Application
     .ScreenUpdating = True
    .EnableEvents = True

    End With
End Sub
'=========================================
Sub SHOW_ALL()
 With Application
     .ScreenUpdating = False
     .EnableEvents = False
    End With
On Error Resume Next
Sheets("ورقة1").ShowAllData
On Error GoTo 0
 With Application
     .ScreenUpdating = True
     .EnableEvents = True
    End With
End Sub
'======================================
Sub quelque_chose()
With Sheets("ورقة1")
Dim i%: i = 3
Dim arr
Dim rg As Object
Set rg = CreateObject("system.collections.arraylist")
With rg
 Do Until Range("j" & i) = vbNullString

  If Not .contains(Range("j" & i).Value) Then .Add Range("J" & i).Value
 i = i + 1
 Loop
 .Sort
 arr = .toarray
 arr = Join(arr, ",")
 End With
 
 With .Range("L2").Validation
 .Delete
 .Add xlValidateList, Formula1:=arr
  End With
  End With
End Sub

FILE HERE

 

ايتام دار البر by_CHOOSE_filter.xlsm