Trojan
Thành viên hoạt động
- Tham gia
- 13/3/08
- Bài viết
- 162
- Được thích
- 78
Tôi đang viết một chương trình để kẻ phân trang, thêm dòng tại mỗi cuối trang mà chạy không đúng yêu cầu. Các mem giúp tôi chỉnh sửa đoạn code của sub addfooter nhé. Đây là đoạn code của tôi
Trong đó hàm riêng "caotrang" là hàm tính chiều cao của một trang, hàm "maxCT" là hàm tính chiều cao trang lớn nhất của một sheet. Xin xem thêm file đính kèm. Cảm ơn mọi người giúp đỡ và góp ý.
Mã:
Private Sub AddFooter()
Application.ScreenUpdating = False
Dim myPage As HPageBreak, iP As Integer, iRb As Integer, iRe As Integer, nRbt As Integer, iReE As Integer
Dim nP, i As Integer
Dim x As String
Dim z As Single
x = MsgBox("Neu chay chuong trinh nay se khong undo duoc va se xoa tat ca cac dong nao co ham subtotal, ban van muon thuc hien?", vbYesNo, "Nguyen Duy Cong")
If x = vbNo Then
Exit Sub
Else
ActiveSheet.Cells.RemoveSubtotal
iRb = Application.InputBox("Nhap dong bat dau cua sheet can chay", "Nguyen Duy Cong", "2")
Selection.SpecialCells(xlCellTypeLastCell).Select
iReE = ActiveCell.Row
nRbt = TEMP.Range("footer").Rows.Count
nP = ActiveSheet.HPageBreaks.Count
ActiveSheet.Range("IV" & iReE).Value = 1
ActiveSheet.Range("IV" & iReE + 1 & ":IV" & (iReE + nP * nRbt)).Formula = "=R[-1]C+1"
nP = ActiveSheet.HPageBreaks.Count
ActiveSheet.Range("IV" & iReE & ":IV" & (iReE + nP * nRbt)).ClearContents
z = Range("footer").RowHeight
With ActiveSheet
For iP = 1 To nP 'check
If z + caotrang(iP) < maxCT() Then
iRe = ActiveSheet.HPageBreaks(iP).Location.Row - nRbt
TEMP.Range("footer").Copy
Rows(iRe).Insert xlShiftDown, True
.Range("F" & iRe + 1).Formula = "=SUBTOTAL(9,F" & iRb & ":F" & (iRe - 1) & ")"
iRb = iRe + nRbt
Else
Do Until z + caotrang(iP) > maxCT()
iRe = ActiveSheet.HPageBreaks(iP).Location.Row - nRbt - iP - 1
TEMP.Range("footer").Copy
Rows(iRe).Insert xlShiftDown, True
.Range("F" & iRe + 1).Formula = "=SUBTOTAL(9,F" & iRb & ":F" & (iRe - 1) & ")"
iRb = iRe + nRbt
iP = iP + 1
Loop
End If
Next i
End With
End If
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
File đính kèm
Lần chỉnh sửa cuối: