Tự động kẻ khung bao cho trang in (3 người xem)

[boyxin]

Chào các bác

Bảng tính em có nhiều trang (ngắt trang tự động và ngắt trang bằng Insert\Page Breck lẫn lộn lung tung)

Em muốn dùng VBA tự động kẻ khung bao cho trang in mà mày mò mãi chưa ra giải pháp

Mong được ACE để ý giúp

 

[TrungChinhs]

Code này cho ta biết đường phân trang nằm ở những dòng nào, dựa vào đây để giải quyết vấn đề của bạn.

Sub HPageBreak()
    ActiveWindow.View = 2
    For i = 1 To ActiveSheet.HPageBreaks.Count
         MsgBox ActiveSheet.HPageBreaks(i).Location.Row-1
    Next
    ActiveWindow.View = 1
End Sub

 

[boyxin]

Em cảm ơn bác TrungChinhs nhé

Sub HPageBreaks_BorderAround()
Dim i As Long, ir As Long
Application.ScreenUpdating = False
With ActiveSheet
    ActiveWindow.View = 2
    [a1].Resize(.HPageBreaks(1).Location.Row - 1, 7).BorderAround LineStyle:=1
    For i = 2 To .HPageBreaks.Count
    ir = .HPageBreaks(i).Location.Row - .HPageBreaks(i - 1).Location.Row
    Cells(.HPageBreaks(i - 1).Location.Row, 1).Resize(ir, 7).BorderAround LineStyle:=1
    Next
    ActiveWindow.View = 1
End With
Application.ScreenUpdating = True
End Sub

Bảng tính của em có hơn chục trang mà code này chạy chậm kinh (máy không đến nõi cùi lắm) ACE xem và cải thiện tốc độ giúp em với

 

[hieuxd]

Em vẫn dùng Code này để viền cuối trang:
Nói chung là Code này chạy tốt dù có chậm nhưng nhanh hơn mình làm thủ công
Gia lệnh chạy Code rồi đi uống nước chè chờ viền hết cuối trang bảng tính

Sub getPageBreak()
Dim sh As Worksheet, ra As Range, hPB As HPageBreak, i As Long
With Application
.ScreenUpdating = False
Set sh = ActiveSheet
'sh.ResetAllPageBreaks
sh.Range("A:A").ClearComments
ActiveWindow.View = xlPageBreakPreview
On Error Resume Next
For i = 1 To sh.HPageBreaks.Count
'thay doi gia tri X trong Resize(2, X) theo so cot thuc te cua bang tinh' thay doi gia tri X trong Offset(2, X) theo cot bat dau vien
With sh.HPageBreaks(i).Location.Offset(-1, 0).Resize(2, 20)
.Borders(xlInsideHorizontal).LineStyle = xlLineStyleNone
.Borders(xlInsideHorizontal).LineStyle = xlContinuous ' 1 net - 2 net: xlDouble'' xlContinuous'xlLineStyleNone
End With
Next
On Error GoTo 0
ActiveWindow.View = xlPageBreakPreview
.ScreenUpdating = True
End With
End Sub



Code này mình Tải trên diễn đàn GPE
Rất mong mọi người tối ưu Code để cải thiện tốc độ

 

[TrungChinhs]

Bảng tính của em có hơn chục trang mà code này chạy chậm kinh (máy không đến nõi cùi lắm) ACE xem và cải thiện tốc độ giúp em với

Bạn dùng thử củ chuối này vậy. Lưu ý dữ liệu phải bắt đầu từ cột B
Với dữ liệu khoảng 10.000 dòng chia thành 200 trang chạy mất khoảng 20 giây.

Lý do chậm một phần là do phải ActiveWindow.View = 2 để tìm đường tự phân trang của máy nếu không thì nó chỉ tìm thấy đường phân trang bằng tay. Vì vậy phải chấp nhận chậm.

Để cải thiện tốc độ thì khi tìm thấy HPageBreaks ta chưa kẻ bảng vội mà chỉ đánh dấu dòng đó bằng ký tự "x" chẳng hạn rồi sau đó dựa vào ký tự này để xác định vùng kẻ bảng, sau khi kẻ xong thì xóa ký tự này đi.

Với cách này có thể áp dụng để chèn thêm dòng tổng cộng cuối mỗi trang.

Sub HPageBreaks_BorderAround()
    Application.ScreenUpdating = False
    On Error Resume Next
    With ActiveSheet
        ActiveWindow.View = 2
        For i = 1 To .HPageBreaks.Count
            .Cells(.HPageBreaks(i).Location.Row, 1) = "x"
        Next
        With .[a:a].SpecialCells(2)
            For i = 1 To .Areas.Count
                Range(.Areas(i), .Areas(i + 1)(0)).Offset(, 1).Resize(, 10).BorderAround 1
            Next
        .Areas(1)(0, 2).Resize(, 10).Borders(4).LineStyle = 1
        .Areas(.Areas.Count)(1, 2).Resize(, 10).Borders(3).LineStyle = 1
        End With
        .[a:a].Clear
        .[b5].SpecialCells(5).BorderAround 1
        ActiveWindow.View = 1
    End With
End Sub