اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

طلب كود طباعة بشرط


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

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

اخواني الاعزاء احتاج لكود طباعة الملف المرفق

بحيث يتم استبعاد الاسطر التي تحتوي على صفر في خليتين في عمودين بنفس السطر

مثال : اذا الخلية a15 قيمتها صفر  والخلية e15  قيمتها صفر يتم استبعاد السطر

اما اذا قيمة الخلية في a15 تساوي صفر وقيمة الخليه e15  اكبر من الصفر فلا يتم استبعاده

مرفق ملف للتوضيح

مع خالص تحياتي:fff:

code.rar

تم تعديل بواسطه مختار البركاني
رابط هذا التعليق
شارك

أخي الكريم مختار

جرب الكود التالي عله يفي بالغرض

Sub PrintPage()
    Dim I As Integer
    
    Application.ScreenUpdating = 0
        For I = 8 To Cells(Rows.Count, 1).End(3).Row
            If Cells(I, 1) = 0 And Cells(I, 5) = 0 Then Cells(I, 1).EntireRow.Hidden = True
        Next I
        
        'للطباعة [PrintOut] بكلمة [PrintPreview] استبدل كلمة
        ActiveSheet.PrintPreview
        
        Cells.EntireRow.Hidden = False
    Application.ScreenUpdating = 1
End Sub

 

 

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

وهذا كود آخر أسرع من الأول

Sub PrintPage()
    Dim MyRange As Range, Cel As Range, Rng As Range
    
    Application.ScreenUpdating = 0
        Set MyRange = Range(Cells(8, 1), Cells(Cells(Rows.Count, 1).End(3).Row, 1))
        
        For Each Cel In MyRange
            If Cel.Value = 0 And Cel.Offset(, 4).Value = 0 Then
                If Not Cel Is Nothing Then If Rng Is Nothing Then Set Rng = Cel Else Set Rng = Union(Rng, Cel)
            End If
        Next Cel
        
        If Not Rng Is Nothing Then Rng.EntireRow.Hidden = True
        
        'للطباعة [PrintOut] بكلمة [PrintPreview] استبدل كلمة
        ActiveSheet.PrintPreview
        
        Cells.EntireRow.Hidden = False
    Application.ScreenUpdating = 1
End Sub

 

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

أخي الكريم مختار البركاني

السطر الأول هو سطر للإعلان عن المتغيرات المستخدمة في الكود

السطر التالي

Set MyRange = Range(Cells(8, 1), Cells(Cells(Rows.Count, 1).End(3).Row, 1))

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

هذا الجزء من الكود

For Each Cel In MyRange
            If Cel.Value = 0 And Cel.Offset(, 4).Value = 0 Then
                If Not Cel Is Nothing Then If Rng Is Nothing Then Set Rng = Cel Else Set Rng = Union(Rng, Cel)
            End If
        Next Cel

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

يتم اختبار قيمة الخلية وكذلك قيمة الخلية في العمود الخامس التي تبعد عن الخلية الحالية بمقدار 4 أعمدة في نفس الصف ، فإذا كانت الخليتين قيمتهما = صفر يتم تنفيذ السطر التالي

والذي يقوم بتخزين نطاق الخلية الحالية في متغير آخر باسم Rng .. وفي كل حلقة يتم تخزين النطاق الجديد إضافة إلى النطاق القديم ..

بمعنى يتم تجميع نطاقات الخلايا التي ينطبق عليها الشرط

ثم

 If Not Rng Is Nothing Then Rng.EntireRow.Hidden = True

يتم إخفاء الصفوف للنطاق المسمى Rng (الخلايا التي انطبق عليها الشرط) مرة واحدة

وهذا أسرع من الكود الأول الذي يقوم بالتعامل مع صف صف ...

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

ActiveSheet.PrintPreview

أخيراً يتم معاينة أو طباعة ورقة العمل النشطة

وفي نهاية المطاف يتم إظهار الصفوف التي تم إخفائها مرة أخرى

أرجو أن تكون الصورة قد اتضحت أخي الكريم

تقبل تحياتي

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

ما شاء الله تبارك الله 

                                                                         استاذياسر خليل أبو البراء

ربنا يحفظك ويوفقك ويزيدك في علمك ويرضى عليك دنيا واخرة

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

بارك الله فيك أخي مختار وجزيت خيراً على دعائك الطيب ولك بمثل إن شاء الله

الحمد لله الذي بنعمته تتم الصالحات

تقبل وافر تقديري واحترامي

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

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