طباعة جدل كثير الصفوف مقسم

[mohsen mohamed]

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

السادة الأساتذة الكرام أرجو من حضراتكم معرفة طباعة جدول ذو صفوف كثيرة مقسم على عدة أوراق بحيث كل ورقة تحتوي على 25 صف مجمعةمع ترحيل الجمع للورقة التي تليها.

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

مرفق ورقة العمل مرتبات.xlsxمرتبات.xlsx

[أبومروان]

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

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

Sub Print25RowsPerPage()

    Dim wsSource As Worksheet
    Dim rowCount As Long
    Dim rowsPerPage As Long
    Dim i As Long
    Dim printRange As Range
    Dim pageNum As Long
    
    ' تحديد ورقة العمل المصدر
    Set wsSource = ThisWorkbook.Sheets("ورقة1") ' تأكد من تغيير اسم الورقة إلى الورقة المناسبة
    
    rowCount = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row ' حساب عدد الصفوف
    rowsPerPage = 25 ' عدد الصفوف في كل ورقة
    pageNum = 1 ' لتتبع رقم الصفحة أثناء الطباعة

    ' التكرار عبر الصفوف وتقسيمها على أوراق الطباعة
    For i = 1 To rowCount Step rowsPerPage
        
        ' تحديد نطاق الطباعة (25 صفًا لكل ورقة)
        Set printRange = wsSource.Rows(i & ":" & WorksheetFunction.Min(i + rowsPerPage - 1, rowCount))
        
        ' تعيين نطاق الطباعة
        wsSource.PageSetup.PrintArea = printRange.Address
        
        ' تعيين إعدادات الطباعة (اختياري: إذا كنت تريد تغيير إعدادات الطباعة)
        With wsSource.PageSetup
            .Orientation = xlPortrait ' وضع الصفحة عمودي (يمكنك تغييره إلى xlLandscape إذا أردت الوضع الأفقي)
            .FitToPagesWide = 1 ' تأكد من طباعة الصفحة على عرض واحد
            .FitToPagesTall = False ' لا تحدد عدد الصفوف على الصفحة
            .LeftHeader = "صفحة " & pageNum ' عنوان الصفحة
        End With
        
        ' طباعة النطاق المحدد
        wsSource.PrintOut
        
        ' تحديث رقم الصفحة
        pageNum = pageNum + 1
    Next i