Nhờ các anh chị giúp về code lặp lại tiêu đề bảng khi in (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

cua090909

Thành viên mới
Tham gia
8/6/17
Bài viết
3
Được thích
0
Giới tính
Nam
z6442369440713_99ec72e4d46171c822db45ea6d507817.jpg
Hiện tại e đang có file như này,phần bảng trên file sẽ thay đổi với chiều dài các bảng khác nhau.
Mọi người giúp e code để khi in tự động xác định bảng nằm trong 1 trang hay hai trang:
- Nếu bảng nằm gọn trong trang in thứ nhất và phần dữ liệu sau bảng ở trang thứ 2, thì không lặp lại tiêu đề bảng.
- Nếu bảng nằm trong trang in thứ nhất và thứ 2 thì lặp lại tiêu đề bảng.
 
Lần chỉnh sửa cuối:
Mình cũng có bài toán tương tự.
Mình có thử hỏi AI mà chưa giải quyết được triệt để vấn đề này. Trường hợp nếu đoạn cuối sau bảng tính nằm giữa 2 trang thì bị lặp lại tiêu đề chưa đúng ý lắm.
Cũng mong các Anh/Chị GPE xem code sau, sửa/ hoàn thiện giúp em.
Em cảm ơn.
Mã:
Sub PrintBienBan()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim footerRows As Long
    Dim tableStartRow As Long
    Dim tableEndRow As Long
    Dim totalRows As Long
    Dim pageRows As Long

    ' Thiết lập các giá trị ban đầu
    Set ws = ThisWorkbook.Sheets("Sheet1")
    footerRows = 5
    tableStartRow = 4

    ' Xác định dòng cuối cùng của bảng biểu A
    '5 là số thứ tự cột xác định dòng cuối
    lastRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row
    tableEndRow = lastRow - footerRows

    ' Tính toán số dòng trên mỗi trang
    pageRows = CalculatePageRows(ws)

    ' Xác định tổng số dòng của bảng biểu A và 5 dòng cuối cùng
    totalRows = tableEndRow + footerRows

    ' Thêm khoảng trống nếu cần thiết để đảm bảo 5 dòng cuối cùng không bị chia cắt
    If (totalRows Mod pageRows) > (pageRows - footerRows) Then
        ws.Rows(tableEndRow + 1 & ":" & tableEndRow + (pageRows - (totalRows Mod pageRows))).Insert Shift:=xlDown
    End If

    ' Thiết lập vùng in, bao gồm thêm 5 dòng cuối cùng
    With ws.PageSetup
        .PrintTitleRows = "$" & tableStartRow & ":$" & tableStartRow ' Lặp lại dòng tiêu đề
        .PrintArea = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow + footerRows, ws.Columns.Count)).Address
    End With

    ' In ấn
    ws.PrintOut
End Sub

Function CalculatePageRows(ws As Worksheet) As Long
    Dim tempSheet As Worksheet
    Dim pageRows As Long
    Dim i As Long

    ' Tạo một sheet tạm thời để tính toán số dòng trên mỗi trang
    Set tempSheet = ThisWorkbook.Sheets.Add

    ' Sao chép cấu trúc trang từ sheet gốc
    With tempSheet.PageSetup
        .Orientation = ws.PageSetup.Orientation
        .PaperSize = ws.PageSetup.PaperSize
        .FitToPagesWide = ws.PageSetup.FitToPagesWide
        .FitToPagesTall = ws.PageSetup.FitToPagesTall
        .Zoom = ws.PageSetup.Zoom
        .LeftMargin = ws.PageSetup.LeftMargin
        .RightMargin = ws.PageSetup.RightMargin
        .TopMargin = ws.PageSetup.TopMargin
        .BottomMargin = ws.PageSetup.BottomMargin
        .HeaderMargin = ws.PageSetup.HeaderMargin
        .FooterMargin = ws.PageSetup.FooterMargin
    End With

    ' Thêm dữ liệu mẫu để tính toán số dòng trên mỗi trang
    For i = 1 To 1000
        tempSheet.Cells(i, 1).Value = "Sample"
    Next i

    ' Tính toán số dòng trên mỗi trang
    tempSheet.DisplayPageBreaks = True
    pageRows = tempSheet.HPageBreaks(1).Location.Row - 1

    ' Xóa sheet tạm thời
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True

    CalculatePageRows = pageRows
End Function
 

File đính kèm

Upvote 0
Mình cũng có bài toán tương tự.
Mình có thử hỏi AI mà chưa giải quyết được triệt để vấn đề này. Trường hợp nếu đoạn cuối sau bảng tính nằm giữa 2 trang thì bị lặp lại tiêu đề chưa đúng ý lắm.
Cũng mong các Anh/Chị GPE xem code sau, sửa/ hoàn thiện giúp em.
Em cảm ơn.
Mã:
Sub PrintBienBan()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim footerRows As Long
    Dim tableStartRow As Long
    Dim tableEndRow As Long
    Dim totalRows As Long
    Dim pageRows As Long

    ' Thiết lập các giá trị ban đầu
    Set ws = ThisWorkbook.Sheets("Sheet1")
    footerRows = 5
    tableStartRow = 4

    ' Xác định dòng cuối cùng của bảng biểu A
    '5 là số thứ tự cột xác định dòng cuối
    lastRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row
    tableEndRow = lastRow - footerRows

    ' Tính toán số dòng trên mỗi trang
    pageRows = CalculatePageRows(ws)

    ' Xác định tổng số dòng của bảng biểu A và 5 dòng cuối cùng
    totalRows = tableEndRow + footerRows

    ' Thêm khoảng trống nếu cần thiết để đảm bảo 5 dòng cuối cùng không bị chia cắt
    If (totalRows Mod pageRows) > (pageRows - footerRows) Then
        ws.Rows(tableEndRow + 1 & ":" & tableEndRow + (pageRows - (totalRows Mod pageRows))).Insert Shift:=xlDown
    End If

    ' Thiết lập vùng in, bao gồm thêm 5 dòng cuối cùng
    With ws.PageSetup
        .PrintTitleRows = "$" & tableStartRow & ":$" & tableStartRow ' Lặp lại dòng tiêu đề
        .PrintArea = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow + footerRows, ws.Columns.Count)).Address
    End With

    ' In ấn
    ws.PrintOut
End Sub

Function CalculatePageRows(ws As Worksheet) As Long
    Dim tempSheet As Worksheet
    Dim pageRows As Long
    Dim i As Long

    ' Tạo một sheet tạm thời để tính toán số dòng trên mỗi trang
    Set tempSheet = ThisWorkbook.Sheets.Add

    ' Sao chép cấu trúc trang từ sheet gốc
    With tempSheet.PageSetup
        .Orientation = ws.PageSetup.Orientation
        .PaperSize = ws.PageSetup.PaperSize
        .FitToPagesWide = ws.PageSetup.FitToPagesWide
        .FitToPagesTall = ws.PageSetup.FitToPagesTall
        .Zoom = ws.PageSetup.Zoom
        .LeftMargin = ws.PageSetup.LeftMargin
        .RightMargin = ws.PageSetup.RightMargin
        .TopMargin = ws.PageSetup.TopMargin
        .BottomMargin = ws.PageSetup.BottomMargin
        .HeaderMargin = ws.PageSetup.HeaderMargin
        .FooterMargin = ws.PageSetup.FooterMargin
    End With

    ' Thêm dữ liệu mẫu để tính toán số dòng trên mỗi trang
    For i = 1 To 1000
        tempSheet.Cells(i, 1).Value = "Sample"
    Next i

    ' Tính toán số dòng trên mỗi trang
    tempSheet.DisplayPageBreaks = True
    pageRows = tempSheet.HPageBreaks(1).Location.Row - 1

    ' Xóa sheet tạm thời
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True

    CalculatePageRows = pageRows
End Function
Bạn có đính kèm sai file mẫu không
 
Upvote 0
Mình cũng có bài toán tương tự.
Mình có thử hỏi AI mà chưa giải quyết được triệt để vấn đề này. Trường hợp nếu đoạn cuối sau bảng tính nằm giữa 2 trang thì bị lặp lại tiêu đề chưa đúng ý lắm.
Cũng mong các Anh/Chị GPE xem code sau, sửa/ hoàn thiện giúp em.
Em cảm ơn.
Mã:
Sub PrintBienBan()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim footerRows As Long
    Dim tableStartRow As Long
    Dim tableEndRow As Long
    Dim totalRows As Long
    Dim pageRows As Long

    ' Thiết lập các giá trị ban đầu
    Set ws = ThisWorkbook.Sheets("Sheet1")
    footerRows = 5
    tableStartRow = 4

    ' Xác định dòng cuối cùng của bảng biểu A
    '5 là số thứ tự cột xác định dòng cuối
    lastRow = ws.Cells(ws.Rows.Count, 5).End(xlUp).Row
    tableEndRow = lastRow - footerRows

    ' Tính toán số dòng trên mỗi trang
    pageRows = CalculatePageRows(ws)

    ' Xác định tổng số dòng của bảng biểu A và 5 dòng cuối cùng
    totalRows = tableEndRow + footerRows

    ' Thêm khoảng trống nếu cần thiết để đảm bảo 5 dòng cuối cùng không bị chia cắt
    If (totalRows Mod pageRows) > (pageRows - footerRows) Then
        ws.Rows(tableEndRow + 1 & ":" & tableEndRow + (pageRows - (totalRows Mod pageRows))).Insert Shift:=xlDown
    End If

    ' Thiết lập vùng in, bao gồm thêm 5 dòng cuối cùng
    With ws.PageSetup
        .PrintTitleRows = "$" & tableStartRow & ":$" & tableStartRow ' Lặp lại dòng tiêu đề
        .PrintArea = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow + footerRows, ws.Columns.Count)).Address
    End With

    ' In ấn
    ws.PrintOut
End Sub

Function CalculatePageRows(ws As Worksheet) As Long
    Dim tempSheet As Worksheet
    Dim pageRows As Long
    Dim i As Long

    ' Tạo một sheet tạm thời để tính toán số dòng trên mỗi trang
    Set tempSheet = ThisWorkbook.Sheets.Add

    ' Sao chép cấu trúc trang từ sheet gốc
    With tempSheet.PageSetup
        .Orientation = ws.PageSetup.Orientation
        .PaperSize = ws.PageSetup.PaperSize
        .FitToPagesWide = ws.PageSetup.FitToPagesWide
        .FitToPagesTall = ws.PageSetup.FitToPagesTall
        .Zoom = ws.PageSetup.Zoom
        .LeftMargin = ws.PageSetup.LeftMargin
        .RightMargin = ws.PageSetup.RightMargin
        .TopMargin = ws.PageSetup.TopMargin
        .BottomMargin = ws.PageSetup.BottomMargin
        .HeaderMargin = ws.PageSetup.HeaderMargin
        .FooterMargin = ws.PageSetup.FooterMargin
    End With

    ' Thêm dữ liệu mẫu để tính toán số dòng trên mỗi trang
    For i = 1 To 1000
        tempSheet.Cells(i, 1).Value = "Sample"
    Next i

    ' Tính toán số dòng trên mỗi trang
    tempSheet.DisplayPageBreaks = True
    pageRows = tempSheet.HPageBreaks(1).Location.Row - 1

    ' Xóa sheet tạm thời
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True

    CalculatePageRows = pageRows
End Function
Mình cũng thử dùng chat GPT nhưng cũng không giải quyết được vấn đề, mình đang suy nghĩ theo hướng:
- Xác định vị trí bảng trong trang in
- Xác định bảng nằm trong trang 1 hay cả hai trang
- Nếu bảng nằm trong hai trang, tính vị trí bảng bị ngắt sang trang mới.
- Copy tiêu đề paste tại vị trí ngắt bảng đó
 
Upvote 0
Ở Tab Page Layout bạn chọn Print Titles, rồi thiết lập chọn dòng sẽ lặp lại tại Rows to repead at top

Nếu bảng chỉ nằm trong trang 1, thì cần tạo bảng. Nếu bảng có cột gộp thì không tạo bảng được, lúc này cần dùng VBA đếm số trang để thiết lập Rows to repead at top

1742994411673.png
 
Upvote 0
Ở Tab Page Layout bạn chọn Print Titles, rồi thiết lập chọn dòng sẽ lặp lại tại Rows to repead at top

Nếu bảng chỉ nằm trong trang 1, thì cần tạo bảng. Nếu bảng có cột gộp thì không tạo bảng được, lúc này cần dùng VBA đếm số trang để thiết lập Rows to repead at top

View attachment 307625
Anh HeSanbi ơi, trường hợp mà vùng dưới bảng biểu có 1 đoạn/ vài dòng dữ liệu nữa (ví dụ người lập/chữ ký) bị trường hợp khi in nằm ở 2 trang thì sẽ bị tiêu đề chèn giữa 2 dòng người lập / chữ ký thì có cách nào xử lý không ạ.
Mong muốn xử lý bỏ tiêu đề ở trang cuối nếu đoạn/ vài dòng dữ liệu cuối nằm ở 2 trang khi in.
Em có thử ActiveWindow.View = xlPageBreakPreview nhưng chưa tối ưu được. Nhờ Anh xem giúp ạ.
Mã:
Sub TieuDeTrangCuoi()
On Error Resume Next
Application.ScreenUpdating = False
Dim myPage As HPageBreak

Set ws = ThisWorkbook.Sheets("Sheet1")

ActiveWindow.View = xlPageBreakPreview
With ws
For Each myPage In ws.HPageBreaks
    ws.Range("A4:G4").Copy
    Rows(myPage.Location.Row).Insert xlShiftDown, True
Next
End With
ActiveWindow.View = xlNormalView
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

1743066079322.png
 
Lần chỉnh sửa cuối:
Upvote 0
Chỉ có cách là dùng VBA để xử lý, dùng VBA để hỗ trợ in
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom