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

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


إذهب إلى أفضل إجابة Solved by محمد هشام.,

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

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

يمكنك ذلك عن طريق كود 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

 

  • Like 3
رابط هذا التعليق
شارك

  • أفضل إجابة

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

تفضل اخي

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

  • Like 5
رابط هذا التعليق
شارك

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

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

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

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

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

 

رابط هذا التعليق
شارك

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

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

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

رابط هذا التعليق
شارك

2 hours ago, Mohamed Hicham said:

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

https://streamable.com/3qn2ug

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

WhatsApp Image 2023-01-19 at 20.20.01.jpg

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information