Board logo

標題: [發問] 如何做成自動分頁(頁碼)效果? [打印本頁]
作者: luke    時間: 2013-6-12 18:52     標題: 如何做成自動分頁(頁碼)效果?

各位大大

1.[Sheet1表]的「A:O欄」為資料區, 其中“A1:O8”儲存格當作【列印標題列】範圍,
    自第9列以後會有數量不定的資料區塊(包含一些合併儲存格),
    約有100多個資料列當作【設定列印範圍】.

2.如何將“A1:O8”儲存格定義成固定標題列, 由第9列開始計算,
    每14列為1個資料區塊做成自動分頁(頁碼)效果如附檔說明.

煩請先進 大大指導
[attach]15242[/attach]
作者: stillfish00    時間: 2013-6-13 20:15

本帖最後由 stillfish00 於 2013-6-13 20:20 編輯

回復 1# luke
問題不是很懂，如果是指插入標題列，產生如"結果"的工作表 :
  1. Sub TEST()
  2.     Dim iPageCount As Integer
  3.    
  4.     Application.ScreenUpdating = False
  5.     With Sheets("sheet1")
  6.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
  7.         For i = 1 To iPageCount * 22 Step 22
  8.             If i = 1 Then
  9.                 .Cells(5, "M").Value = 1
  10.                 .Cells(5, "O").Value = iPageCount
  11.             Else
  12.                 .Range("A1:O8").Copy
  13.                 .Cells(i, 1).Insert Shift:=xlDown
  14.                 .Cells(i + 4, "M").Value = Int(i / 22) + 1
  15.             End If
  16.         Next
  17.         Application.CutCopyMode = False
  18.     End With
  19.     Application.ScreenUpdating = True
  20. End Sub
複製代碼
作者: luke    時間: 2013-6-13 22:41

回復 2# stillfish00

進行測試後符合

感謝stillfish00 多次協助

以上
作者: GBKEE    時間: 2013-6-15 15:30

回復 1# luke
  1. Option Explicit
  2. Sub TEST()
  3.     Dim iPageCount As Integer, i As Integer
  4.     Application.ScreenUpdating = False
  5.     With Sheets("Sheet1")
  6.         .Activate
  7.         .PageSetup.PrintTitleRows = "$1:$5"                           '標題列
  8.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
  9.         .Cells(5, "O").Value = iPageCount
  10.         For i = 1 To iPageCount
  11.             .Cells(5, "M").Value = i
  12.             .Range(.Cells(9 + ((i - 1) * 14), "a"), .Cells(22 + ((i - 1) * 14), "O")).Name = "Print_Area"  '印列範圍
  13.             .PrintOut                                                 '印列
  14.         Next
  15.         .Names("Print_Area").Delete
  16.         .Names("Print_Titles").Delete
  17.     End With
  18.     Application.ScreenUpdating = True
  19. End Sub
複製代碼
作者: luke    時間: 2013-6-15 23:09

回復 4# GBKEE

謝謝超版回覆

若[Sheet1表]資料區(指A:O欄)的表格中,
有一些整列是無任何資料的表格列(即空白資料列)
且該空白表格列的位置不固定.

如何先行刪除這些空白表格列,
如本例第19列、第33列、第44列、第47列和第55-60列
直到無空白表格列為止.

應如何修改VBA?
[attach]15250[/attach]
作者: lilytracy    時間: 2013-6-16 11:27

本帖最後由 lilytracy 於 2013-6-16 11:39 編輯

回復 5# luke

清除空表格列參考如下
  1. Sub RowClear()
  2. Dim row, i, j As Long
  3. row = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).row
  4. Application.ScreenUpdating = False
  5. Range(Cells(9, 1), Cells(row, 1)).Select
  6. For i = 9 To row
  7. If Cells(i, 1).Value = "" And Cells(i, 3).Value = "" And Cells(i, 8).Value = "" Then
  8.     Rows(i).Select
  9.     Selection.Delete Shift:=xlUp
  10.      i = i - 1
  11.      j = j + 1
  12.     If j = row Then
  13.         Exit For
  14.     End If
  15. End If
  16. Next
  17. Application.ScreenUpdating = True
  18. End Sub
複製代碼
作者: GBKEE    時間: 2013-6-16 16:14

回復 5# luke
  1. Sub TEST()
  2.     Dim iPageCount As Integer, i As Integer
  3.     Application.ScreenUpdating = False
  4.     With Sheets("Sheet1")
  5.         For i = .UsedRange.Rows.Count To 9 Step -1
  6.             If Application.Phonetic(.Rows(i)) = "" Then .Rows(i).Delete
  7.         Next
  8.         .Activate
  9.         .PageSetup.PrintTitleRows = "$1:$5"                           '標題列
  10.         iPageCount = (.[A7].CurrentRegion.Rows.Count - 2) / 14
  11.         .Cells(5, "O").Value = iPageCount
  12.         For i = 1 To iPageCount
  13.             .Cells(5, "M").Value = i
  14.             .Range(.Cells(9 + ((i - 1) * 14), "a"), .Cells(22 + ((i - 1) * 14), "O")).Name = "Print_Area"  '印列範圍
  15.             .PrintPreview            '.PrintOut                                                        '印列
  16.         Next
  17.         .Names("Print_Area").Delete
  18.         .Names("Print_Titles").Delete
  19.     End With
  20.     Application.ScreenUpdating = True
  21. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)