طباعة عدد معين من الصفوف في شيت اكسل

[طارق محمود]

السلام عليكم ورحمة الله وبركاته
جائني علي الخاص الرسالة التالية من أخونا الفاضل (رجب محمد)

=====================================

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

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

===================================
إنتهت الرسالة
ولم يكن أخونا رجب يستطيع رفع الملف
 

المهم

نصحته باستخدام الكود التالي

Sub Macro1()
LR = Sheet1.[A99999].End(xlUp).Row
    For r = (15 + 19) To LR Step 20 ' يمكنك استبدال الرقم 15 برقم أول سطر بعد العناوين
        ActiveSheet.HPageBreaks.Add Before:=Cells(r, 1)
    Next
End Sub

وبعد إرسال الملف لي واستئذانه في نشره
هذا هو الملف مرفق بعد عمل اللازم (ليس به معلومات تضر بمصلحة العمل)

 

بيج بريك.rar

[طارق محمود]

وهذه الصورة لشرح كيفية فتح موضوع جديد

 

[ياسر خليل أبو البراء]

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

لكم تشتاق نفسي لرؤية مشاركاتك بالمنتدى ، فمنكم تعلمنا وما زلنا ننهل من علمكم الغزير .. بارك الله فيك وجزاك الله خيراً على هذا الكود المميز والرائع

أحببت أن أشارك ولو بشيء بسيط ، مشاركتي مجرد شرح بسيط جداً للكود حتى يستفيد الأخوة الكرام من الكود

Sub AddPageBreaks()
    Dim R As Long, LR As Long
'تحديد رقم آخر صف به بيانات في العمود الأول
    LR = Sheet1.[A99999].End(xlUp).Row
'إعادة ضبط كل فواصل الصفحات
    ActiveSheet.ResetAllPageBreaks
'يمكنك استبدال الرقم 15 برقم أول سطر بعد العناوين
'يمثل الرقم 20 عدد الأسطر أو الصفوف المطلوبة في كل صفحة
    For R = (15 + 20) To LR Step 20
'عمل فاصل للصفحات قبل نهاية كل حلقة تكرارية
        ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1)
'الانتقال للحلقة التالية
    Next
End Sub

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

[طارق محمود]

أخي وحبيبي الغالي أبا البراء
مشاركتك ومرورك علي مواضيعي شرف عظيم
ولاداعي للتواضع ، إن كنت تصر علي موضوع الأستاذ والمعلم

فأنا صدقا أراك قطعت شوطا كبيرا وأصبحت أفضل مني بكثير في الإكسل

لك كل الحب والتقدير

[ابو جودى]

م / طارق محمود

ا/ ياسر خليل أبو البراء

موضوع مهم و مميز

جزاكم الله خيرا

[ياسر خليل أبو البراء]

أخي في الله وأستاذي ومعلمي (ولن أنسى أبداً أني تتلمذت على يديك)

لا يجوز لي - حتى لو بدا لك أني تحسنت بعض الشيء - لا يجوز لي أبداً أن أتعدى أستاذي

بارك الله لنا فيك ، وكلامك وسام على صدري وفخر لي

 

جزيت عنا خير الجزاء وجمعنا الله في الجنة في الفردوس الأعلى

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

[رجب مرسي]

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

لكم تشتاق نفسي لرؤية مشاركاتك بالمنتدى ، فمنكم تعلمنا وما زلنا ننهل من علمكم الغزير .. بارك الله فيك وجزاك الله خيراً على هذا الكود المميز والرائع

أحببت أن أشارك ولو بشيء بسيط ، مشاركتي مجرد شرح بسيط جداً للكود حتى يستفيد الأخوة الكرام من الكود

Sub AddPageBreaks()
    Dim R As Long, LR As Long
'تحديد رقم آخر صف به بيانات في العمود الأول
    LR = Sheet1.[A99999].End(xlUp).Row
'إعادة ضبط كل فواصل الصفحات
    ActiveSheet.ResetAllPageBreaks
'يمكنك استبدال الرقم 15 برقم أول سطر بعد العناوين
'يمثل الرقم 20 عدد الأسطر أو الصفوف المطلوبة في كل صفحة
    For R = (15 + 20) To LR Step 20
'عمل فاصل للصفحات قبل نهاية كل حلقة تكرارية
        ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1)
'الانتقال للحلقة التالية
    Next
End Sub

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

جزاكم الله خيرا عنا جميعا وتقبا الله منكم ما تقمون بة ولكن هل يمكن تغير شئ في الكود بحيث يطبع مثلا 30 بدلا من عشرين لانني غيرت 20 الى 30 في الكود ولكنها لم تضبط معي وشكر لكم  على كل حال

تم تعديل أبريل 30, 2015 بواسطه ragab65

[ياسر خليل أبو البراء]

الأخ الكريم رجب

يرجى تغيير اسم الظهور للغة العربية لسهولة التواصل

يرجى مراجعة رابط التوجيهات

http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147

 

بالنسبة لمشكلتك

جرب تغير رقم 20 إلى 30 (لاحظ أن رقم 20 يوجد مرتين)

Sub AddPageBreaks()
    Dim R As Long, LR As Long
    LR = Sheet1.[A99999].End(xlUp).Row
    ActiveSheet.ResetAllPageBreaks
    For R = (15 + 30) To LR Step 30
        ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1)
    Next
End Sub

أو قم بإرفاق ملف للإطلاع عليه إذا ظلت المشكلة موجودة

تقبل تحياتي

[رجب مرسي]

الأخ الكريم رجب

يرجى تغيير اسم الظهور للغة العربية لسهولة التواصل

يرجى مراجعة رابط التوجيهات

http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147

 

بالنسبة لمشكلتك

جرب تغير رقم 20 إلى 30 (لاحظ أن رقم 20 يوجد مرتين)

Sub AddPageBreaks()
    Dim R As Long, LR As Long
    LR = Sheet1.[A99999].End(xlUp).Row
    ActiveSheet.ResetAllPageBreaks
    For R = (15 + 30) To LR Step 30
        ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1)
    Next
End Sub

أو قم بإرفاق ملف للإطلاع عليه إذا ظلت المشكلة موجودة

تقبل تحياتي

الاخ العزيز ابو البراء بعد السلام عليكم قمت بتغير اسم الظهور كما طلبت الى رجب مرسي ثانيا غيرت رقم عشرين في الكود الى رقم 30  ولكن في صفحاة معاينة الطباعة يعطي 22 وليس 20 او ثلاثون  شكرا على سرعة الرد وجزاكم جميعا كل الخيربيج بريك.rar

[الزباري]

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

[ياسر خليل أبو البراء]

الاخ الكريم رجب

الكود شغال بشكل طبيعي ، لكن تكمن المشكلة في الملف نفسه

الأخ صاحب الملف عامل حاجة اسمها Print Area

هتقوم بالغاء الـ Print Area من التبويب Page Layout ثم Print Area ثم Clear Print Area

نفذ الكود وشوف النتيجة ، ومتنساش تدعي لي يا رجب

[أيمن ابراهيم]

الشكر كل الشكر للاســـتاذ طارق محمود والاستــاذ ياسر خليل على هذا الموضوع الرائع والمهم 

جزاكم الله عنا كل خير

جعلكم الله عوناً لنا 

[رجب مرسي]

الاخ الكريم رجب

الكود شغال بشكل طبيعي ، لكن تكمن المشكلة في الملف نفسه

الأخ صاحب الملف عامل حاجة اسمها Print Area

هتقوم بالغاء الـ Print Area من التبويب Page Layout ثم Print Area ثم Clear Print Area

نفذ الكود وشوف النتيجة ، ومتنساش تدعي لي يا رجب

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