Boo.Reema قام بنشر أغسطس 15, 2018 قام بنشر أغسطس 15, 2018 السلام عليكم ورحمة الله وبركاته العنوان يدل على المطلوب ومرفق ملف بسيط للتجربة عليه أرجو الإفادة Microsoft Excel Worksheet جديد.rar
سليم حاصبيا قام بنشر أغسطس 15, 2018 قام بنشر أغسطس 15, 2018 جرب هذا الملف (من دون يوزر) لاني لا احب التعامل مع اليوزر فورم الكود Sub InsertPageBreaks_with_choosen_row() If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out If Not IsNumeric(Range("N1")) Or Range("N1") < 5 Then GoTo Leave_Me_Out Range("N1") = Int(Range("N1")) Application.ScreenUpdating = False Dim Xrow% Dim i% Dim xLastrow As Long Dim x% Dim xWs As Worksheet Set xWs = Application.ActiveSheet xWs.PageSetup.PrintTitleRows = "$10:$11" xWs.PageSetup.FitToPagesWide = 1 Xrow = Range("N1") 'Xrow = Application.InputBox("How Many Rows in page?", "Salim tell you", Type:=1) xWs.ResetAllPageBreaks xLastrow = Cells(Rows.Count, 2).End(3).Row + 4 For i = Xrow + 12 To xLastrow Step Xrow xWs.HPageBreaks.Add Before:=xWs.Cells(i, 1) x = xLastrow - i If x < Xrow Then xWs.HPageBreaks.Add Before:=xWs.Cells(i + x + 1, 1) Exit For End If Next Leave_Me_Out: Application.ScreenUpdating = True End Sub الملف مرفق Variable Print Area.xls 2
Boo.Reema قام بنشر أغسطس 15, 2018 الكاتب قام بنشر أغسطس 15, 2018 فى ملف التجربة رائعة جدا فى الملف الأصلى لم تعمل على الاطلاق هل ارفق لكم الملف الاصلى
Boo.Reema قام بنشر أغسطس 15, 2018 الكاتب قام بنشر أغسطس 15, 2018 إليكم الملف الأصلى أريد تنفيذ الكود على الصفحة Print العدد فيها 500 طالب وعلى كل الصفحات من 1 إلى 10 وهى بنفس التنسيقات يختلف اسم الصفحة فقط العدد فى كل صفحة 50 طالب أرجو ألا أكون أثقل عليكم K G.rar
Boo.Reema قام بنشر أغسطس 15, 2018 الكاتب قام بنشر أغسطس 15, 2018 سليم حاصبيا فى الانتظار منكم أو من أى أعضاء الموقع الكرام
Boo.Reema قام بنشر أغسطس 15, 2018 الكاتب قام بنشر أغسطس 15, 2018 سليم حاصبيا لم يعمل ايضا برغم ترقيم العمود B يقوم بتغيير مساحة الطباعة الى الافتراضى يعنى عمود الاسم فى صفحة وتاريخ الميلاد فى صفحة والرقم القومى فى صفحة للأسف لم يعمل على الملف الأصلى
سليم حاصبيا قام بنشر أغسطس 15, 2018 قام بنشر أغسطس 15, 2018 تم معالجة الامر بالنسبة للصفحة Print بالنسبة لبقية الصفحات سوف يعمل الكود اذا تم جذف هذا السطر منه (بوضع كلمة Rem) امامه وتغيير اسم الكود (حتى لا يختلط الكودين مع بعض) If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out ملاحظة (لا نتس وصع الرقم المناسب في الخلية N1) ليصبح هكذا مثلاً Sub InsertPageBreaks_with_choosen_row_for_All() Rem If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out If Not IsNumeric(Range("N1")) Or Range("N1") < 5 Then GoTo Leave_Me_Out Range("N1") = Int(Range("N1")) Application.ScreenUpdating = False Dim Xrow% Dim i% Dim xLastrow As Long Dim x% Dim xWs As Worksheet Set xWs = Application.ActiveSheet xWs.PageSetup.PrintTitleRows = "$10:$11" xWs.PageSetup.FitToPagesWide = 1 Xrow = Range("N1") 'Xrow = Application.InputBox("How Many Rows in page?", "Salim tell you", Type:=1) xWs.ResetAllPageBreaks xLastrow = Cells(Rows.Count, 2).End(3).Row + 4 For i = Xrow + 12 To xLastrow Step Xrow xWs.HPageBreaks.Add Before:=xWs.Cells(i, 1) x = xLastrow - i If x < Xrow Then xWs.HPageBreaks.Add Before:=xWs.Cells(i + x + 1, 1) Exit For End If Next xWs.PageSetup.FitToPagesWide = 1 Leave_Me_Out: Application.ScreenUpdating = True End Sub K G_Salim.xls 1 1
Boo.Reema قام بنشر أغسطس 15, 2018 الكاتب قام بنشر أغسطس 15, 2018 جزاك الله خيرا على جهدك معى وجعله فى ميزان حسناتك 1
محمد عبدالسلام قام بنشر أغسطس 20, 2018 قام بنشر أغسطس 20, 2018 (معدل) عمل رائع تم تعديل أغسطس 20, 2018 بواسطه محمد عبدالسلام
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.