نزار سليمان عيد

وعليكم السلام ممكن لو سمحت توضح المكتوب حسب الطلب اعلاه سيتكرر الاسم 3 مرات في الشهر واذا ممكن تبعث ملف فيه حل يدوي لتثبيت الفكرة ومشاهدة كيف التوزيع وليس كل الاسماء اختار مثلا 20 اسم واكتب شكل الحل

فضلا انظر للمرفق مع العلم حضرتك طلباتك مختلفه في كل مرحله test_print (1) (1).xlsm

فضلا من صاحب السؤال التاكيد على الحل لاقفال الموضوع حيث تم عمل المطلوب test_print (1) (1).xlsm

عندك حل الاستاذ محمد حسن بالمعادلات

تحتاج لهذه المعادله =(IF(LEFT(C6,1)="3","السنة الثالثة",IF(LEFT(C6,1)="2","السنة الثانية","السنة الاولى"))) انظر للمرفق مستوى.xlsx

بامكانك ذلك من البيانات فرز الى اعمده او بالماكرو انظر للمرفق واي استفسار خبرني الهدف.xlsx.xls

انا قصدي بنفس مثالك يوجد اسم مكرر 3 مرات واسم اخر بس مره هل هذا صح من باب التوزيع العادل للمستويات

هل الاسماء بالملف توزيعها صحيح

فضلا انظر للمرفق test_print (1).xlsm

وايضا هذا الكود وتحدد عدد السطور دون الدخول للماكرو Sub InsertPageBreaksEveryXRow() Dim xLastrow As Long Dim xWs As Worksheet Set xWs = Application.ActiveSheet xRow = Application.InputBox("أدخل عدد السطور المراد طباعتها في كل صفحه", xTitleId, "", Type:=1) xWs.ResetAllPageBreaks xLastrow = xWs.Range("A1").SpecialCells(xlCellTypeLastCell).Row For i = xRow + 1 To xLastrow Step xRow xWs.HPageBreaks.Add Before:=xWs.Cells(i, 1) Next End Sub انظر للمرفق test_print (1).xlsm

فضلا جرب هذا الكود Sub TextBox1_Click() For i = 1 To 200 Step 19 ActiveSheet.HPageBreaks.Add Before:=Cells(i + 1, 1) Next End Sub انظر للمرفق test_print.xlsm

كل الاحترام استاذ محمد بالعكس اضافاتك مميزة وتضفي اثراء للمشاركات كل عام وانتم بخير

تحتاج لهذا الكود Sub PrintA() 'prints rows of data, will not print rows if column A is blank Application.ScreenUpdating = False Range("A:A").EntireRow.Hidden = False Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ActiveWindow.SelectedSheets.PrintOut Copies:=1 Range("A:A").EntireRow.Hidden = False Application.ScreenUpdating = True End Sub او هذا الكود Sub PrintSummary() Dim myrange As String myrange = Cells(Rows.Count, 17).End(xlUp).Address ActiveSheet.PageSetup.PrintArea = "$A$1:" & myrange Application.Goto Reference:="R1C1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False End Sub فضلا انظر للمرفق طبع الصفحات التي تحتوي على بيانات.xlsx123 (1).xlsm

تفضل انظر للمرفق مدد الخدمة المسجلة بالتامينات.xls

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