معاينة محددة

[hussinabdo1111@hotmail.com]

السلام عليكم

في المرفق التالي اريد عمل معاينة محددة واجهتني عدة مشكلات

حيث اننى اريد معاينة محددة للمدى الاول

مع عمل طباعة للعناوين فالطباعة اكثر من ورقة

وعمل AutoFilter

وبعد اريد عمل الغاء لكل ما سبق وعمل معاينة للمدى الثانى

وعمل طباعة للعناوين

وعمل AutoFilterجديد للمدى الثانى

معاينة محددة.rar

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

جرب هذا الملف 

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

Print Set_up.zip

[hussinabdo1111@hotmail.com]

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

لكن لو فرضا ان الصفحة الاولى اكثر من ورقة سوف تكون في معاينة الطباعة نصف الورقة الاخير من النطاق الاول ونصف الورقة الاولة من النطاق الثانى

مثل الصور التالية

هما نطاقان

الاول به الاتي نطاق محدد من الطباعة

AutoFilter وعناوين طباعة

اريد في النطاق الثاني ايضا

نطاق طباعة وAutoFilter وعناوين طباعة

يستلزم ذلك الغاء نطاق الطباعة الاولى والعناوين وAutoFilter

 

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

لم أفهم السؤال بالضبط

لكن عندي تصور لما تريده

في كل صفحة ( من صفحات الورقة الواحدة)يحب ازالة الصفوف الفارغة (يمكن ذلك عبر ماكرو مخصص)يجري تفعيله قبل ماكرو المعاينة

على فكرة الملف الذي رفعته انت مصاب بقيروس و قد رفض للجهاز عندي فتحه لذلك رفعت لك ملف ذموذج 

تم تعديل أكتوبر 14, 2015 بواسطه سليم حاصبيا

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

جرب هذا لكود (انه يقوم بطباعة كل 25 سطر على صفحة واحدة مع العنوان الرئيسي) يمكنك تغيير العدد 25 من خلا ل الكود

بتغيير مقدار العامل  deg في السطر رقم 10 للمزيد انظر الى المرفق

Sub my_setup()
        Application.ScreenUpdating = False
        k = 0
        ActiveSheet.PageSetup.PrintArea = ""
        lr1 = Cells(Rows.Count, 1).End(3).Row
        On Error Resume Next
        ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
        Range("a1:a" & lr1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
        deg = 25 'you can change this number
        lr = Cells(Rows.Count, 1).End(3).Row
For i = 0 To lr Step deg

        If lr - i < deg Then Exit For
        ActiveWindow.View = xlPageBreakPreview
        Set ActiveSheet.HPageBreaks(k + 1).Location = Range("A" & i + deg + 2)

        k = k + 1
Next

    m = "$A$1:$E$" & lr1 & """"
    ActiveSheet.PageSetup.PrintArea = m
ActiveSheet.DisplayPageBreaks = False
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

 

My_print_Set_Up.zip

تم تعديل أكتوبر 15, 2015 بواسطه سليم حاصبيا

[وائل الاسيوطي]

On ‎10‎/‎15‎/‎2015‎ ‎1‎:‎54‎:‎01‎, سليم حاصبيا said:

جرب هذا لكود (انه يقوم بطباعة كل 25 سطر على صفحة واحدة مع العنوان الرئيسي) يمكنك تغيير العدد 25 من خلا ل الكود

بتغيير مقدار العامل  deg في السطر رقم 10 للمزيد انظر الى المرفق

Sub my_setup()
        Application.ScreenUpdating = False
        k = 0
        ActiveSheet.PageSetup.PrintArea = ""
        lr1 = Cells(Rows.Count, 1).End(3).Row
        On Error Resume Next
        ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
        Range("a1:a" & lr1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        
        deg = 25 'you can change this number
        lr = Cells(Rows.Count, 1).End(3).Row
For i = 0 To lr Step deg

        If lr - i < deg Then Exit For
        ActiveWindow.View = xlPageBreakPreview
        Set ActiveSheet.HPageBreaks(k + 1).Location = Range("A" & i + deg + 2)

        k = k + 1
Next

    m = "$A$1:$E$" & lr1 & """"
    ActiveSheet.PageSetup.PrintArea = m
ActiveSheet.DisplayPageBreaks = False
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub

 

My_print_Set_Up.zip

ارجو رفع الملف مره اخري اخي سليم

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

27 دقائق مضت, وائل الاسيوطي said:

ارجو رفع الملف مره اخري اخي سليم

تفضل اخي وائل الملف مع الكود المناسب

Print Set_up.zip

[وائل الاسيوطي]

شكرا اخي سليم