[Cần giúp đỡ] Tạo subtotal tự động ở trang in bằng VBA - Phần mềm ôn thi sát hạch chứng chỉ hành nghề xây dựng

[Visual Basic] 纯文本查看 复制代码
Option Explicit



Public Sub AddFooterX()

Application.ScreenUpdating = False

Dim myPage As HPageBreak, iP As Integer, iRb As Integer, iRe As Integer, nRbt As Integer, iReE As Integer

Dim nP As Integer

Dim myviewmode, mysheet

    mysheet = ActiveSheet.Name

    myviewmode = ActiveWindow.View

With Sheets(mysheet).Range("A13")

    Sheets(mysheet).Cells.RemoveSubtotal

End With



iRb = TEMP.Range("DongBatDau").Value

iReE = TEMP.Range("DongCuoiCung").Value + 1

nRbt = TEMP.Range("CONGHETTRANG").Rows.Count

With Sheets(mysheet)

    nP = .HPageBreaks.Count

    .Range("A" & iReE).Value = 1

    .Range("A" & iReE + 1 & ":A" & (iReE + nP * nRbt)).Formula = "=R[-1]C+1"



    iP = 0

End With

With Sheets(mysheet)



For iP = 1 To nP + 1

    If iP <= nP Then

        iRe = Sheets(mysheet).HPageBreaks(iP).Location.Row - nRbt + 1

        TEMP.Range("CONGHETTRANG").Copy

    Else

        iRe = nP * nRbt + TEMP.Range("DongCuoiCung").Value + 1

        TEMP.Range("CongTrangCuoi").Copy

    End If

    Rows(iRe).Insert xlShiftDown, True





    

    .Range("F" & iRe + 1).Formula = "=SUBTOTAL(9,F" & TEMP.Range("DongBatDau").Value & ":F" & (iRe - 1) & ")"

    .Range("G" & iRe + 1).Formula = "=SUBTOTAL(9,G" & TEMP.Range("DongBatDau").Value & ":G" & (iRe - 1) & ")"

    If iP <= nP Then

        .Range("F" & (iRe + nRbt - 1)).Formula = .Range("F" & (iRe + 1)).Formula

        .Range("G" & (iRe + nRbt - 1)).Formula = .Range("G" & (iRe + 1)).Formula

    Else

        .Range("F" & iRe + 2).Formula = "=F" & TEMP.Range("DongBatDau").Value - 1 & "+F" & (iRe + 1) _

                                            & "-G" & TEMP.Range("DongBatDau").Value - 1 & "-G" & (iRe + 1)

        If .Range("F" & iRe + 2).Value < 0 Then

            .Range("G" & iRe + 2).Formula = "=-F" & TEMP.Range("DongBatDau").Value - 1 & "-F" & (iRe + 1) _

                                            & "+G" & TEMP.Range("DongBatDau").Value - 1 & "+G" & (iRe + 1)

            .Range("F" & iRe + 2).ClearContents

        End If

    

    End If

    iRb = iRe + nRbt

Next iP

End With

Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub





Public Sub XoaFooterX()

Dim mysheet

    mysheet = ActiveSheet.Name

With Sheets(mysheet)

    Application.ScreenUpdating = False

    .Range("A13").Select

    .Cells.RemoveSubtotal

    Application.ScreenUpdating = True

 End With

End Sub