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
ActiveWorkbook.Close 0
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub作者: ikboy 時間: 2015-8-17 13:14
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作者: pop780906 時間: 2015-8-17 15:42