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

[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
    

 

[mohsen mohamed]

عزيزي الأستاذ أبو مروان شكرا لحضرك للأهتمام بالموضوع

لكن مش عارف أعمل ازاي باقي الكود من هنا إلى الأخر لأني ضعيف جدا في ال vba ومعرفش عنه إلا قشور البدايات

.FitToPagesWide = 1 ' تأكد من طباعة الصفحة على عرض واحد
            .FitToPagesTall = False ' لا تحدد عدد الصفوف على الصفحة
            .LeftHeader = "صفحة " & pageNum ' عنوان الصفحة
        End With
        
        ' طباعة النطاق المحدد
        wsSource.PrintOut
        
        ' تحديث رقم الصفحة
        pageNum = pageNum + 1
    Next i

تم تعديل منذ 3 ساعات بواسطه mohsen mohamed

[أبومروان]

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

Sub PrintSheetInChunks()
    Dim ws As Worksheet
    Dim LastRow As Long, LastCol As Long
    Dim RowStart As Long, RowEnd As Long
    Dim ColStart As Long, ColEnd As Long
    Dim PageNum As Long

    ' تحديد ورقة العمل الحالية
    Set ws = ThisWorkbook.Sheets("Sheet1") ' قم بتغيير اسم الورقة حسب الحاجة

    ' الحصول على آخر صف وآخر عمود في البيانات
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' تحديد عدد الصفوف والأعمدة لكل صفحة (25 صفًا و25 عمودًا)
    RowStart = 1
    ColStart = 1
    PageNum = 1

    ' تحديد الصفوف والأعمدة للطباعة
    Do While RowStart <= LastRow
        RowEnd = RowStart + 24 ' 25 صفًا لكل صفحة (من RowStart إلى RowEnd)
        If RowEnd > LastRow Then RowEnd = LastRow

        ColEnd = ColStart + 24 ' 25 عمودًا لكل صفحة (من ColStart إلى ColEnd)
        If ColEnd > LastCol Then ColEnd = LastCol

        ' تحديد منطقة الطباعة
        ws.PageSetup.PrintArea = ws.Range(ws.Cells(RowStart, ColStart), ws.Cells(RowEnd, ColEnd)).Address

        ' إعدادات الطباعة
        With ws.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
            .PrintTitleRows = "" ' إذا أردت إضافة عناوين ثابتة في الأعلى يمكنك تعديل هذه
            .PrintTitleColumns = "" ' وإذا أردت إضافة أعمدة ثابتة يمكنك تعديل هذه
        End With

        ' طباعة الصفحة
        ws.PrintOut

        ' تحديث الصفوف والأعمدة للطباعة في الصفحة التالية
        RowStart = RowEnd + 1
        If RowStart > LastRow Then Exit Do ' الخروج إذا تم الانتهاء من جميع الصفوف

        If ColEnd < LastCol Then
            ColStart = ColEnd + 1
        Else
            ColStart = 1
        End If

        PageNum = PageNum + 1
    Loop
End Sub

 

مرتبات.xlsm