- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 6# zhiling
因為每台印表機設定一頁有幾個 Rows 是不一定
這裡試試看- Option Explicit
- Sub Ex()
- Dim Msg As String, xi As Integer
- With ActiveSheet
- If Application.CountA(.Range("a1").CurrentRegion) = 0 Then
- MsgBox "範圍內沒有資料可印列"
- Exit Sub
- End If
- ActiveWindow.View = xlPageBreakPreview
- .PageSetup.PrintArea = .Range("a1").CurrentRegion.Address
- .PageSetup.PrintTitleRows = "$1:$1"
- .PageSetup.LeftFooter = "&14&N 頁- &P"
- '頁尾右邊: &14-> 字體Size =14, &N->總頁數, &P->第幾頁
- For xi = 0 To .HPageBreaks.Count
- Msg = "&14 小計: " '&14: 字體Size =14
- If xi = 0 Then
- Msg = Msg & Application.Sum(.Range([b2], .HPageBreaks(1).Location.Cells(0, 2)))
- ElseIf xi > 0 And xi < .HPageBreaks.Count Then
- Msg = Msg & Application.Sum(.Range(.HPageBreaks(xi).Location.Cells(1, 2), .HPageBreaks(xi + 1).Location.Cells(0, 2)))
- Msg = Msg & Chr(10) & "累計: " & Application.Sum(.Range([b2], .HPageBreaks(xi + 1).Location.Cells(0, 2)))
- Else
- Msg = Msg & Application.Sum(.Range(.HPageBreaks(.HPageBreaks.Count).Location, .[b2].End(xlDown)))
- Msg = Msg & Chr(10) & "累計: " & Application.Sum(.Range("B:B"))
- End If
- .PageSetup.RightFooter = Msg '頁尾左邊:
- .PrintOut From:=xi + 1, To:=xi + 1, Copies:=1 '一頁一頁印列
- Next
- .DisplayPageBreaks = False '取消分頁線
- End With
- ActiveWindow.View = xlNormalView
- MsgBox "印列 完成"
- End Sub
複製代碼 應用在 3# 檔案 如圖的資料中
|
|