Nhờ các mem giúp sửa đoạn code này.

  • Thread starter Thread starter Trojan
  • Ngày gửi Ngày gửi
Liên hệ QC

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
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
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 ý.
 

File đính kèm

Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom