[發問] 請教表頭跟表尾列印

pop780906

下載 (135.05 KB)

2015-8-15 12:24

如圖表示,黃色部分與下一頁是重覆的
只有中間列不一樣
因為中間列有序號需要一直延續下去
我知道有標題列印的方法,但我的尾端就沒辦法用這方法
想請教各位大大..
有其他方法能用嗎
因為我需要的頁面超過30頁
每次都是以人工方式複製對工作上有點耗時..
麻煩各位大大了,救救我吧..

lpk187

回復 1# pop780906

我的方法比較笨，不過你可以試試看。
頁尾的部份我是先製作圖片，然後在自定頁尾貼上圖片，再調整到自已想要的格式

pop780906

回復 2# lpk187


   謝謝大大回覆,因為大大是希望說下面那兩格要直接可以key in的..
   所以就變成有點麻煩..

ikboy

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

忘了說明這是我的想法是.
您的問題可能衹有VBA才可解決
1. 先計算列印頁的高上限(即在一頁內所能列印的所有行高總和),這裡我不懂自動計算, 請老師指導
2. 求出頁頭總行高的和
3. 求出頁腳總行高的和
4. 度出列印資料的高
5. 進行每頁列印重組

VBA 程序大致為在 4# 所寫

ikboy

剛才試了一下有欠,現修正如下:

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

回復 6# ikboy

表頭6cm
表尾4cm

看不太懂高度要打在語法的哪邊..請大大指教~~謝謝

ikboy

假設您的頁頭是由 A1:K7
修改 Set hd = Range(您的頁頭) 為 Set hd = Range("A1:K7")
如此類推 修改 Set fn = Range(您的頁尾)
一般A4 一頁能容行高 710, 如 超出一頁, 請修改 avh = 710  為 avh = 700 或更少

pop780906

回復 8# ikboy

TEST.rar (15.89 KB)

下載次數: 0

2015-8-18 08:16

下載 (137.5 KB)

2015-8-18 08:17

不太懂語法~~輸入後出現錯誤~~
附上附件Excel啟用巨集檔案
請大大指導~~~謝謝>"<

ikboy

很抱歉,由於我的權限未能下載, 請在模組中按F8遂步執行至問題處,把問題顯示再查下。