[發問] 如何做成自動分頁(頁碼)效果?

luke

各位大大

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

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

煩請先進 大大指導
TEST31.rar (26.99 KB)

下載次數: 6

2013-6-12 18:52

stillfish00

回復 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

回復 2# stillfish00

進行測試後符合

感謝stillfish00 多次協助

以上

GBKEE

回復 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

回復 4# GBKEE

謝謝超版回覆

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

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

應如何修改VBA?
TEST31-1.rar (27.64 KB)

下載次數: 5

2013-6-15 23:09

lilytracy

回復 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

回復 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

複製代碼