Cần giúp đỡ Làm tổng subtotal cuối ở mỗi trang in

Liên hệ QC

anhthuc_lhx

Thành viên mới
Tham gia
19/4/13
Bài viết
4
Được thích
0
Mọi người ơi, em mới học thêm VBA vào các file tính toán của em. Em có dựa vào 1 bài code trên trang giaiphapexcel để tạo tổng subtoal ở cuối mỗi trang in, nhưng em làm nhưng vẫn còn lỗi là bị chạy 1 dòng trắng qua trang khác (hình Add). Và khi mình chạy sub Delete thì bảng tính của mình không thể quay lại như file ban đầu ạ (hình Delete). Mình xin úp hình, file excel và code, nhờ mọi người xem giúp là e nên sửa như thế nào với ạ.
Mã:
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"

    nP = .HPageBreaks.Count
    .Range("A" & iReE & ":A" & (iReE + nP * nRbt)).ClearContents

    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
.
 

File đính kèm

  • Add.PNG
    Add.PNG
    31.5 KB · Đọc: 3
  • Delete (1).PNG
    Delete (1).PNG
    15.8 KB · Đọc: 3
  • EndPageSum thuc2.xls
    EndPageSum thuc2.xls
    69.5 KB · Đọc: 4
Lần chỉnh sửa cuối:
Web KT

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

Back
Top Bottom