تذييل الصفحة

[سمرقند الجيلاني]

مساء الخير الاخوة الكرام...

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

وانا ما فيني اتنازل عن اي كلمة لان كل البيانات عن اعتماد الصفحات بالورقة 

تشمل الادارة وبيانات الادخال والتوقيعات والتاريخ ولازم تكون موجودة بكل ورقة

ولكم الشكر من الاخت سمرقند

[ياسر العربى]

الاخت الكريمة تفضلي هذه الفكرة لعلها تفيدك

يتم نسخ اسطر لعمل تذييل من كعب الشيت الى شيت ناجح بعد كل 30 طالب مثلا ؟؟؟!!

تقبلي تحياتي

 

1213123.rar

[ناصر سعيد]

Sub RoundedRectangle3_Click()
    Dim last As Long
    Dim y As Long
    y = 40
    Do
        Application.ScreenUpdating = False
        last = Sheets("ناجح").Range("a10000").End(xlUp).Row
        If y - 36 >= last Then GoTo 0
        Sheets("كعب الشيت").Rows("2:7").Copy
        Sheets("ناجح").Rows(y).Insert Shift:=xlDown
        Application.CutCopyMode = False
        y = y + 36
    Loop
0   Application.ScreenUpdating = True
    MsgBox "تم بحمد لله"
End Sub

رائع جزاك الله كل خير استاذ ياسر العربي

ولكن راس الصفوف اللي المفروض هاتنطبع مغ كل صفحة ..... المطلوب ظهورها في الطباعه

 

ممكن نسخه 2003 كرما منكم

تم تعديل يونيو 13, 2016 بواسطه ناصر سعيد
تكبير الخط

[ياسر العربى]

تفضل اخي الكريم ناصر

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

1213123.rar

 

 

[ناصر سعيد]

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

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

حتى يكتمل الجمال والدقه محتاجين كود لضبط معاينه الطباعه

[ناصر سعيد]

  ' 'هذا الكود للمحترم ياسر العربي
Sub RoundedRectangle3_Click()
    Dim last As Long
    Dim y As Long
    ''  اول صف سيوضع فيه التذييل
    y = 40
    Do
    
    ' '  لمنع اهتزاز الشاشه
        Application.ScreenUpdating = False
        last = Sheets("ناجح").Range("a10000").End(xlUp).Row
        If y - 36 >= last Then GoTo 0
        
        ' '  اسم شيت المصدر الذي سيتم حشر الديباجخ فيه
        Sheets("كعب الشيت").Rows("2:7").Copy
        
        
        ' '  اسم شيت الديباجه التى نريد وضعها في الشيت المصدر
        Sheets("ناجح").Rows(y).Insert Shift:=xlDown
        
            ' 'لايقاف خاصيه القص والنسخ
        Application.CutCopyMode = False
        
        ' '
        y = y + 36
    Loop
    
    ' ' لاعاده تحديث الشاشه
0   Application.ScreenUpdating = True
    MsgBox "تم بحمد لله"
End Sub
' ' ' ' ' ' ' ' ' ' ' ' ' '

الاستاذ الكريم ياسر العربي وضغت شرح لبعض الجمل لكودك الرائع ليكون مرجعا سهلا للاخوه

ارجو ان تكمل الشرح للجمل التي لم استطع شرحها

[سمرقند الجيلاني]

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

الأخ ياسر العربي 

الأخ ناصر سعيد

إذا فيه مجال احكي معك بالخاص لاني ما فهمت شي

تحياتي لجميع السادة المحترفين بالموقع

[asdhamdey]

اليس هذا الموضوع تكرار

 

[ياسر العربى]

شرح الكود

Sub RoundedRectangle3_Click()
    ' الاعلان عن متغير من نوع لونج يشير الى اخر صف به بيانات
    Dim last As Long
    'الاعلان عن متغير من نوع لونج يشير الى كل خطوة لوضع التذييل لكل 30 طالب لكل صفحة
    Dim y As Long
    ''  اول صف سيوضع فيه التذييل
    y = 40
    'لايقاف الحساب التلقائي لعلاج موضوع بطئ عمل الكود اذا كان البطئ من كثرة معادلات المصنف
    Application.Calculation = xlManual
    'حلقة تكرارية تبدأ ب (دو)وتنتهي ب (لووب)وهي لتكرار التذييل حتى ان نصل لاخر صفحه بها بيانات
    Do
        'لمنع اهتزاز الشاشه
        Application.ScreenUpdating = False
        'تعريف المتغير الخاص باخر صف به بيانات
        last = Sheets("ناجح").Range("a10000").End(xlUp).Row
        'هنا نضع شرط اذا كان المتغير واي  اكبر من او يساوي اخر صف به بيانات فيخرج الى خارج الحلقة التكرارية الى السطر الموجود به الصفر
        'وقمنا بانقاص -36 لانه قمنا باضافتها بالاسفل ولكي نقارن بين المتغير واي واخر صف يجب طرح 36 من الواي او اضافتهم الى لاست  
        If y - 36 >= last Then GoTo 0
        ' نسخ الكعب المراد وضعه في صفحة الطلاب
        Sheets("كعب الشيت").Rows("2:7").Copy
       ' وضع الكعب بعد كل 30 طالب وازاحة الباقين للاسفل حتى ينتهي من كل البيانات
        Sheets("ناجح").Rows(y).Insert Shift:=xlDown
        'لايقاف خاصيه القص والنسخ
        Application.CutCopyMode = False
        ' هنا نقوم باضافة 36 للمتغير وهي قيمة ال30 طاللب بالاضافة لهم الكعب 6
        y = y + 36
        ' هنا لوووووب بتقولنا نروح للــ دوووو عشان نعيد الكود تاني حتى يتحقق الشرط السابق من الكود
    Loop
    'هنا بعد تحقق الشرط نجد ان حركة الكود تخرج الى الرقم صفر
    ' ' لاعاده تحديث الشاشه
0   Application.ScreenUpdating = True
    'اعادة الحساب التلقائي
    Application.Calculation = xlAutomatic
    'رسالة تفيد انتهاءالعملية
    MsgBox "تم بحمد لله"
End Sub

 

في ١٣‏/٦‏/٢٠١٦ at 15:09, ناصر سعيد said:

 

 

14 ساعات مضت, سمرقند الجيلاني said:

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

الأخ ياسر العربي 

الأخ ناصر سعيد

إذا فيه مجال احكي معك بالخاص لاني ما فهمت شي

تحياتي لجميع السادة المحترفين بالموقع

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

اذا صعب تطبيقه ارفقى ملف يوضح البيانات وارفقى شكل التذييل المراد تحت احد الصفحات بالشيت

منذ ساعه, asdhamdey said:

اليس هذا الموضوع تكرار

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

 

تقبلو تحياتي

[asdhamdey]

8 دقائق مضت, ياسر العربى said:

last = Sheets("ناجح").Range("a10000").End(xlUp).Row

يجزيك الله كل خير استاذ ياسر العربي

خل يمكن جعل هذا السطر مرن مطاط حسب عدد الطلبه .. لتزيد السرعه

[ياسر العربى]

9 دقائق مضت, asdhamdey said:

يجزيك الله كل خير استاذ ياسر العربي

خل يمكن جعل هذا السطر مرن مطاط حسب عدد الطلبه .. لتزيد السرعه

بالفعل اخي الكريم هو يذهب الى اخر صف به بيانات

لا يغرك الرقم10000

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

والبطئ ليس من الكود البطئ من معادلات المصنف نفسه وقمت بوضع خطوة لتخفيف الكود

ولو مش عجبك دي اكتب دي

last = Sheets("ناجح").Cells(Rows.Count, "a").End(xlUp).Row

وشكرا

[محمد عبدالله المسعودي]

السلام عليكم

الاستاذ ياسر العربي جزاكم الله خيرا

شرح رائع والكود ممتاز جعله الله في ميزان حسناتكم

هناك طلبان اضافيان للكود اذا امكن

الاول : ان يقوم بنسخ التذييل للبيانات الموجودة فعلا مثلا عندي 60 سطر يقوم بوضع تذييل لكل 30 سطر وينتهي اقصد تذيلين فقط

جربت الكود وجدته يضع تذييل حسب النطاق المعموله له بالكود حتى لو لم تكن فيه بيانات فيضع 15 او 20 تذييل

الثاني : هل يمكن مسح التذييل والتراجع عنه  عند الضغط سهوا او اعادة ترتيب وغيره

بارك الله في جهودكم

[ياسر العربى]

اخي الكريم محمد عبدالله

الكود يعمل حسب البيانات الموجودة

ولا يزيد اي تذييل بمعني انه اخر صفحة بها بيانات يوجد بها صفين فقط  مثلا يبقي بعد 28 صف هيتم وضع تذييل الصفحة ويتوقف الكود

ارفق مثالك ووضح المطلوب وباذن الله نعالج الخطأ

تقبل تحياتي

[asdhamdey]

منذ ساعه, محمد عبدالله المسعودي said:

جربت الكود وجدته يضع تذييل حسب النطاق المعمول له بالكود حتى لو لم تكن فيه بيانات فيضع 15 او 20 تذييل

ملحوظه سليمه الكود يضع تذييلات اكثر من المطلوب

[احمد الطحان]

استاذى الفاضل جربت الكود

الصفحة الاولى تمام وبعد ذلك عير موفق

اكيد العيب عندى

Book2.rar

[محي الدين ابو البشر]

السلام عليكم

 

أعتقد والله أعلم أم المشكلة في السطر التالي:

last = Sheets("ناجح").Cells(Rows.Count, "a").End(xlUp).Row

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

 

[ياسر العربى]

تفضل اخي الكريم ضع اي بيانات وهميه وجرب

2 ساعات مضت, احمد الطحان said:

 

 

 

Book2.rar

[محمد عبدالله المسعودي]

السلام عليكم

الاستاذ ياسر العربي جزاكم الله خيرا

الخطأ عندي لان جعلت المدى على العمود A وكان فيه الترقيم التلقائي من خلال معادلات فكان الكود يقرا المعادلة بانها بيانات موجودة

غيرت المدى على البيانات الحقيقية وكان تمام ينتهي الادراج حيث ما تنتهي البيانات

عمل رائع وفقكم الله  

لكم شكري وتقديري

[احمد الطحان]

18 ساعات مضت, ياسر العربى said:

تفضل اخي الكريم ضع اي بيانات وهميه وجرب

 

 

Book2.rar

اولا رمضان كريم

شاكرين ومقدرين على هذا الكود الرائع

جعله الله فى ميزان حسناتك

[asdhamdey]

22 ساعات مضت, ياسر العربى said:

' هنا نقوم باضافة 36 للمتغير وهي قيمة ال30 طاللب بالاضافة لهم الكعب 6

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

 

[سمرقند الجيلاني]

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

اعتذر منكم الاخوة الكرام .. بس توني جديدة بالموقع ما عرفت حتى كيف ارفق الملف..

عشان هيك طلبت الخاص..

احاول ارفقه وفيه المطلوب ..

ولكم مني جزيل الشكر والتقدير

ملف.zip

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

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

أختي الفاضلة سمرقند

أهلاً بك في المنتدى ونورتي بين إخوانك

إذا كنتي تنوين التعامل بالبرمجة والأكواد فأنصح بالإطلاع على الموضوع التالي

من هنا

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

[سمرقند الجيلاني]

مساء الخير...

لك كل الشكر استاذ ياسر ..

بس والله ما فهمت شي كل شي بالانقلش..

شكرا على كل حال

والشكر لكل المحترفين بالموقع