- 帖子
- 262
- 主題
- 8
- 精華
- 0
- 積分
- 280
- 點名
- 16
- 作業系統
- xp
- 軟體版本
- Office 2007
- 閱讀權限
- 20
- 性別
- 男
- 來自
- HK
- 註冊時間
- 2015-8-11
- 最後登錄
- 2024-3-28
|
6#
發表於 2015-8-17 13:24
| 只看該作者
剛才試了一下有欠,現修正如下:
Sub zz()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim usedH, hd As Range, fn As Range, pd As Range
Set hd = Range(您的頁頭)
Set fn = Range(您的頁尾)
Set pd = ActiveSheet.UsedRange
'usedH 將所需列印高度累加
For Each r In hd.Rows
usedH = usedH + r.RowHeight
Next
For Each r In fn.Rows
usedH = usedH + r.RowHeight
Next
'avh 一頁能列印高度
avh = 710 - Int(usedH) '此處我不懂自動計算, 請老師指導
'bodyS 內容開始行, bodyE 內容結尾行
bodyS = hd.Rows.Count + 1
bodyE = pd.Rows.Count - fn.Rows.Count
zc = pd.Columns.Count
Sheets.Copy
Range(Cells(bodyS, 1), Cells([a65536].End(3).Row, 1)).EntireRow.Delete
'pr1 列印內容第一行
pr1 = bodyS
For i = bodyS To bodyE
n = n + pd.Rows(i).RowHeight
If n >= avh Then
Range(pd.Cells(pr1, 1), pd.Cells(i, zc)).Copy Range("a" & [a65536].End(3).Row + 1)
fn.Copy Range("a" & [a65536].End(3).Row + 1)
pr1 = i + 1
n = 0
ActiveSheet.PrintOut Copies:=1
Range(Cells(bodyS, 1), Cells([a65536].End(3).Row, 1)).EntireRow.Delete
End If
Next
If n Then
Range(pd.Cells(pr1, 1), pd.Cells(i, zc)).Copy Range("a" & [a65536].End(3).Row + 1)
fn.Copy Range("a" & [a65536].End(3).Row + 1)
ActiveSheet.PrintOut Copies:=1
Range(Cells(bodyS, 1), Cells([a65536].End(3).Row, 1)).EntireRow.Delete
End If
ActiveWorkbook.Close 0
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub |
|
