返回列表 上一主題 發帖

[發問] 關於不固定欄 自動列印至最後一筆資料

回復 1# starry1314


    給你參考,我的做法
  1. Option Explicit

  2. Sub 巨集1()
  3.     Dim c As Range
  4.     With Sheets("工作表1")
  5.         Set c = .Rows(3).Find("P.P", , , , , 1)
  6.         .PageSetup.PrintArea = "$A$2:" & .Cells(Rows.Count, c.Column).End(xlUp).Address '設定列印範圍
  7.         .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
  8.         Set c = Nothing
  9.         Set c = .Rows(3).Find("P.P", , , , , 2)
  10.         .PageSetup.PrintArea = "$T$2:" & .Cells(Rows.Count, c.Column).End(xlUp).Address
  11.         .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
  12.         Set c = Nothing
  13.     End With
  14. End Sub
複製代碼

TOP

回復 1# starry1314


    也可以這樣!
  1. Option Explicit

  2. Sub 巨集1()
  3.     Dim c As Range
  4.     With Sheets("工作表1")
  5.         Set c = .Rows(3).Find("P.P", , , , , 1) '往後尋找
  6.         .PageSetup.PrintArea = .Range(.Cells(Rows.Count, 1).End(xlUp), Cells(2, c.Column)).Address '設定列印範圍
  7.         .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
  8.         Set c = Nothing
  9.         Set c = .Rows(3).Find("P.P", , , , , 2) '往前尋找
  10.         .PageSetup.PrintArea = .Range(.Cells(Rows.Count, 1).End(xlUp), Cells(2, c.Column)).Address '設定列印範圍
  11.         .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
  12.         Set c = Nothing
  13.     End With
  14. End Sub
複製代碼

TOP

本帖最後由 lpk187 於 2016-4-26 20:42 編輯

回復 8# starry1314

在此先感謝准提部林大大教授的"Print_Area"語法

    利用Range.Find說明範例修改一下,可以達到你的要求,就是再利用FindNext
  1. Sub 巨集1()
  2.     Dim c As Range, firstAddress$, myColumn%
  3.     With Sheets("工作表1")
  4.         Set c = .Rows(3).Find("P.P", LookIn:=xlValues)
  5.             If Not c Is Nothing Then
  6.                 firstAddress = c.Address
  7.                 myColumn = 1
  8.                 Do
  9.                      .Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"
  10.                      .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
  11.                     Set c = .Rows(3).FindNext(c)
  12.                     myColumn = myColumn + 19
  13.                 Loop While Not c Is Nothing And c.Address <> firstAddress
  14.             End If
  15.     End With
  16. End Sub
複製代碼

TOP

回復 11# starry1314


    Option Explicit

Sub 巨集1()
    Dim c As Range, firstAddress$, myColumn%
    With Sheets("工作表1")
        Set c = .Rows(3).Find("P.P", LookIn:=xlValues) '尋求第一個目標物件
            If Not c Is Nothing Then '如果c物件不是為Nothing時,執行
                firstAddress = c.Address '記錄找到的第一個位置
                myColumn = 1 '設定A欄
                Do
                     '.Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area" '
                     .Range(.Cells(Rows.Count, myColumn).End(xlUp), Cells(2, c.Column)).Name = "Print_Area" '設定列印範圍,以設定範圍來說,例如:"A1:C5"和"A5:C1"是一樣的意思
                     '只不過A欄可以找到最後一列,所以要用後者來設定範圍
                     .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
                    Set c = .Rows(3).FindNext(c) '尋找下一個目標物
                    myColumn = myColumn + 19 '下一個個位置為T欄...再來是AM欄,依此類推
                Loop While Not c Is Nothing And c.Address <> firstAddress '當c的位址和第一個位址相同時,跳出迴圈
            End If
    End With
End Sub

TOP

        靜思自在 : 改變自己是自救,影響別人是救人。
返回列表 上一主題