- 帖子
- 967
- 主題
- 0
- 精華
- 0
- 積分
- 1001
- 點名
- 0
- 作業系統
- WIN XP
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-11-29
- 最後登錄
- 2022-5-17
 
|
本帖最後由 register313 於 2012-6-3 23:17 編輯
回復 1# zhiling
 分頁小計累計.rar (14.23 KB)
- Private Sub CommandButton1_Click()
- N = 10
- CommandButton2_Click
- ResetAllPageBreaks
- r = [A65536].End(xlUp).Row
- If r Mod N <> 0 Then m = r \ N + 1
- For i = m To 1 Step -1
- k = i * N + 2
- Rows(k & ":" & k + 1).Insert Shift:=xlDown
- Cells(k, 1) = "小計"
- Cells(k + 1, 1) = "累計"
- Cells(k, 2) = Application.Sum(Range(Cells(k - N, 2), Cells(k - 1, 2)))
- Cells(k + 1, 2) = Application.Sum(Range(Cells(3, 2), Cells(k - 1, 2)))
- HPageBreaks.Add Before:=Range("A" & k + 2)
- Next i
- r = [A65536].End(xlUp).Row
- PageSetup.PrintTitleRows = Rows("1:2").Address
- PageSetup.PrintArea = "$A$2:$B$" & r
- End Sub
- Private Sub CommandButton2_Click()
- Dim Rng As Range
- r = [A65536].End(xlUp).Row
- For i = r To 1 Step -1
- If Cells(i, 1) = "小計" Or Cells(i, 1) = "累計" Then
- If Rng Is Nothing Then
- Set Rng = Rows(i)
- Else
- Set Rng = Union(Rng, Rows(i))
- End If
- End If
- Next i
- If Not Rng Is Nothing Then Rng.Delete
- End Sub
- Private Sub CommandButton1_Click() '加入分頁小計累計
- N = 10 '設定10筆資料一頁
- CommandButton2_Click
- ResetAllPageBreaks '重設所有分頁線
- r = [A65536].End(xlUp).Row
- If r Mod N <> 0 Then m = r \ N + 1 '共有幾個20的倍數
- For i = m To 1 Step -1
- k = i * N + 2
- Rows(k & ":" & k + 1).Insert Shift:=xlDown '加入2列空白列
- Cells(k, 1) = "小計"
- Cells(k + 1, 1) = "累計"
- Cells(k, 2) = Application.Sum(Range(Cells(k - N, 2), Cells(k - 1, 2))) '小計
- Cells(k + 1, 2) = Application.Sum(Range(Cells(3, 2), Cells(k - 1, 2))) '累計
- HPageBreaks.Add Before:=Range("A" & k + 2) '水平分頁線
- Next i
- r = [A65536].End(xlUp).Row
- PageSetup.PrintTitleRows = Rows("1:2").Address '設定標題列
- PageSetup.PrintArea = "$A$2:$B$" & r '設定列印範圍
- End Sub
- Private Sub CommandButton2_Click() '移除分頁小計累計
- Dim Rng As Range
- r = [A65536].End(xlUp).Row
- For i = r To 1 Step -1
- If Cells(i, 1) = "小計" Or Cells(i, 1) = "累計" Then
- If Rng Is Nothing Then
- Set Rng = Rows(i)
- Else
- Set Rng = Union(Rng, Rows(i))
- End If
- End If
- Next i
- If Not Rng Is Nothing Then Rng.Delete
- End Sub
|
|
發表於 2012-6-3 15:53
| 