تثبيت عدد معين من الصفوف لطباعتها

[abdelfattahbadawy]

أريد تثبيت مثلاً من الصف 1 وحتى الصف عشرين لطباعتهم فى صفحة ومن 21 ل37 لطباعتهم فى الصفحة الثانية وهكذا بحيث لايقوم المستخدم بتعديل فواصل الطباعة 

test_print.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 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

[abdelfattahbadawy]

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

[محمد يوسف ابو يوسف]

السلام عليكم

تفضل

الملفtest_print.xlsm

[abdelfattahbadawy]

مشكور أخى محمد لكن هل توجد طريقة لمنع المستخدم من تعديل فواصل الطباعة  التى قمت بتحديدها فى حالة استخدامه ctrl+print؟

[محمد يوسف ابو يوسف]

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

 Private Sub Worksheet_Change(ByVal Target As Range)
     ActiveWindow.View = xlPageBreakPreview
 End Sub

ان لم يكن طلبك .. ممكن توضيح اكثر .. وان شاء الله يتم عمل اللازم 

 

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

في 17‏/4‏/2022 at 11:40, نزار سليمان عيد said:

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

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

انظر للمرفق

تحتاج اضافة هذا الكود 

Dim xPrintRng As Range
Dim xFirstRng As Range
Dim xLastRng As Range
Application.ScreenUpdating = False
With Application.ActiveSheet
.Cells.EntireColumn.Hidden = False
.Cells.EntireRow.Hidden = False
If .PageSetup.PrintArea <> "" Then
Set xPrintRng = .Range(.PageSetup.PrintArea)
Else
Set xPrintRng = .UsedRange
End If
Set xFirstRng = xPrintRng.Cells(1)
Set xLastRng = xPrintRng.Cells(xPrintRng.Count)
If xFirstRng.Row > 1 Then
.Range(.Cells(1, 1), xFirstRng(-0, 1)).EntireRow.Hidden = True
End If
If xFirstRng.Column > 1 Then
.Range(.Cells(1, 1), xFirstRng(1, 0)).EntireColumn.Hidden = True
End If
If xLastRng.Row < .Rows.Count Then
.Range(xLastRng(2, 1), .Cells(.Rows.Count, 1)).EntireRow.Hidden = True
End If
If xLastRng.Column < .Columns.Count Then
.Range(xLastRng(1, 2), .Cells(1, .Columns.Count)).EntireColumn.Hidden = True
End If
End With
Application.ScreenUpdating = True

test_print (1).xlsmFetching info...

فضلا انظر للمرفق

test_print (1).xlsm

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

فضلا من صاحب السؤال التاكيد على الحل لاقفال الموضوع حيث تم عمل المطلوب

test_print (1) (1).xlsm

[abdelfattahbadawy]

أنا كنت عاوز  بعد ماحددت عدد الصفوف اللى هيتم طباعتها إن المستخدم ميعرفش يحرك الخط ده عشان ميعدلش فى عدد الصفوف اللى أن محددها لكن للأسف مش عارف هل طريقة سؤالى هى اللى غلط أو مش عارف أوصل طلبى بالظبط  

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

فضلا انظر للمرفق مع العلم حضرتك طلباتك مختلفه في كل مرحله

test_print (1) (1).xlsm

[abdelfattahbadawy]

مشكور أخى الكريم تم بفضل مجهود حضرتك استاذى الكريم