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

[اشرف عبدالله الفقى]

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

 

اعتماد مستندات.xls

[Ali Mohamed Ali]

وعليكم السلام-تم ضبط وعمل المطلوب بالكود وتجربته بالفعل على الطابعة  ويعمل بكل كفاءة

ملحوظة : عليك بعدم العبث بأبعاد الصفحات او محاولة تغييرها

وهذا هو الكود المستخدم فى ذلك

Private Sub Do_It()
    Application.ScreenUpdating = False
    With Sheets("قطاعات")
        a_max = .Cells(.Rows.Count, "A").End(xlUp).Row
        b_max = a_max
        prows = 45
        a = 5
        Do
            a = a + prows
        Loop Until a + 45 >= a_max
        .Rows(a_max + 1 & ":" & a_max + 3).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Sheets("Sheet1").Range("A1:F3").Copy Destination:=.Cells(a_max + 1, "A")
        b_max = b_max + 3
        For aa = a To 5 + prows Step -prows
            .Rows(aa & ":" & aa + 2).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Sheets("Sheet1").Range("A1:F3").Copy Destination:=.Cells(aa, "A")
            b_max = b_max + 3
        Next aa
        .PageSetup.PrintArea = "A1:F" & b_max
        .PrintOut
        For a = 5 + prows To a_max Step prows
            .Rows(a & ":" & a + 2).Delete shift:=xlUp
        Next a
        .Rows(a_max + 1 & ":" & a_max + 3).Delete shift:=xlUp
        .PageSetup.PrintArea = "A1:F" & a_max
    End With
    Application.ScreenUpdating = True
End Sub

1اعتماد مستندات.xls

[اشرف عبدالله الفقى]

الف مليون شكر استاذنا الكبير على محمد 

كود فى منتهى الروعة ومجهود نحسدك عليه وهذا طبعاً ليس بجديد على عبقرى مثل حضرتك انا قمت بتجربة الكود المرفق وظهر لى الآتى :ـ

1- عند اضافة صف فارغ فى التعليق الموجود فى Sheet1 واضافة السطر المكتوبه فى حسب المرفق لا يظهر التعليق بالكامل فى آخر صفحة يتم طباعتها .

2- عند لصق التعليق فى الصفحات التى توجد فى المنتصف يلصق على بيانات موظفين موجودين ولا يقوم بإزاحتها الى الاسفل وتفسيرا لذلك لدى 111 موظف لو تم تشغيل  الكود سوف يقل عدد الموظفين لأن الكود بدل ما يقوم بإزاحة البيانات الى اسفل سطر فارغ يقوم بالصلق على بيانات موظف موجود وبذلك يقل عدد الموظفين .

آسف جداً على الإطاله لكن الغرض من الكود مهم وسوف ينفع الكثيرين

اشكر حضرتك كثيرا وتقبل تحياتى

1عتماد مستندات نهائى.xls

[Ali Mohamed Ali]

تم ضبط الأبعاد بدقة فعليك بعدم العبث بها

1عتماد مستندات نهائى1.xls

[اشرف عبدالله الفقى]

السلام عليكم استاذى الكبير/ على محمد

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

واطمع فى كرم حضرتك  لو شرح بسيط عن الكود لأنى لدى اكثر من شيت فى ابعاد مختلفة كى اضبطها بنفسى فيما بعد .

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

اعتمادات مستندات .pdf