اخفاء اسطر فارغة اتوماتيكيا

[saleem akhras]

تحية طيبة 

 هل يمكنني اخفاء الاسطر الفارغة اتوماتيكيا حسب الملف المرفق / وفيه شرح عن المطلوب

بكج الافراد.xlsx

[حسونة حسين]

السلام عليكم ورحمه الله وبركاته وبها نبدأ اي موضوع

يمكنك ذلك عن طريق كود vba

كليك يمين على الصفحه (نسخة الزبون)  والضغط على view code  

ثم نسخ هذا الكود ولصقه في حدث الشيت كما هو ولا تنسي يتم حفظ الملف بصيغه تقبل الماكرو xlsm او xlsb

Private Sub Worksheet_Activate()
    Dim r As Range, i As Long
    Cells.EntireRow.Hidden = False
    For i = 7 To 34
       If Cells(i, 2) = "" Then
            If r Is Nothing Then
                Set r = Cells(i, 2)
            Else
                Set r = Union(r, Cells(i, 2))
            End If
        End If
    Next i
     If Not r Is Nothing Then r.EntireRow.Hidden = True
End Sub

 

[saleem akhras]

استاذي بارك الله فيك ، لكن عندما اضيف اسطر من حسابات الافراد لاتظهر عندي في نسخة الزبون هل من طريقة لذلك

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته

تفضل اخي

Private Sub Worksheet_Activate()
Set ws = Sheet1
StartRow = 7    'اول صف
EndRow = 34  ' اخر صف
ColNum = 2  'رقم عمود الشرط

Application.ScreenUpdating = False

'بما انني لاحظت انك واضع حماية للشيت قمنا باضافة فك الحماية لتنفيد الكود ثم ارجاعها
Sheet2.Unprotect    ' في حالة قمت بالغاءها قم بالغاء تفعيل هدا السطر
For i = StartRow To EndRow
If ws.Cells(i, ColNum).Value = "" Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i
Sheet2.Protect    ' وهنا
Application.ScreenUpdating = True
End Sub

 

بكج الافراد.xlsm

[saleem akhras]

بارك الله بجهودك وسلمت يداك 

[saleem akhras]

20 hours ago, Mohamed Hicham said:

وعليكم السلام ورحمة الله تعالى وبركاته

تفضل اخي

Private Sub Worksheet_Activate()
Set ws = Sheet1
StartRow = 7    'اول صف
EndRow = 34  ' اخر صف
ColNum = 2  'رقم عمود الشرط

Application.ScreenUpdating = False

'بما انني لاحظت انك واضع حماية للشيت قمنا باضافة فك الحماية لتنفيد الكود ثم ارجاعها
Sheet2.Unprotect    ' في حالة قمت بالغاءها قم بالغاء تفعيل هدا السطر
For i = StartRow To EndRow
If ws.Cells(i, ColNum).Value = "" Then
Cells(i, ColNum).EntireRow.Hidden = True
Else
Cells(i, ColNum).EntireRow.Hidden = False
End If
Next i
Sheet2.Protect    ' وهنا
Application.ScreenUpdating = True
End Sub

استاذي الكريم 

بعد تجربة الكود على الملف تبين مايلي 

عندما اغلق الملف وافتحه بعد فترة ، لايعمل ، حيث قمت بفتح الفيجوال بيسك لم اجد الكود في الشيت 

ماسبب اختفاؤه ، حيث كلما اغلقته وافتحه مرة اخرى يختفي الكود ولايعمل الشيت

 

[محمد هشام.]

أخي الكريم الكود ستجد شرح طريقة العمل في الرابط التالي

https://streamable.com/3qn2ug

تم تعديل يناير 19, 2023 بواسطه Mohamed Hicham

[saleem akhras]

استاذي الكود يعمل عندي ولكن قصدي انه بعد ما اغلق الملف عندي واعيد فتحه مرة ثانية يختفي الكود من الشيت 

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

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

[saleem akhras]

2 hours ago, Mohamed Hicham said:

أخي الكريم الكود ستجد شرح طريقة العمل في الرابط التالي

https://streamable.com/3qn2ug

عندما اقوم بحفظ الملف عندي بعد نسخ الكود تظهر لي هذه الرسالة 

[محمد هشام.]

اخي هل هناك ملف اخر غير الدي قمت بارفاقه في المشاركة تريد تنفيد الامر عليه

بعد اضافة الكود قم بحفظ الملف بصيغة الماكرو

[saleem akhras]

جزيت الف خير تمت بنجاح