在一個作業中多次打印相同的工作表

Question

我試圖多次打印同一個工作表作爲一個打印作業。我有一個工作表，其中有一個表格，列表爲ID,FirstName，LastName和Age。我有另一個工作表，就像一個表單。 用戶選擇一個ID，其餘列自動填充（First Name, LastName, and Age）。 我已經擁有了代碼，一旦用戶從下拉列表中選擇了他們想要的ID，工作表會自動更新該ID的信息。 我正在嘗試添加一個將爲每個ID打印相同工作表的宏。所以，如果我有2周的例如ID：

1. 代碼將使用現有的宏觀與ID1更新工作表
2. 打印工作表
3. 使用我的代碼以ID2更新工作表
4. 打印工作表

最後，雖然，我想有一個打印作業，其中都有工作表。

我已經知道我可以使用下面的代碼打印工作表分開：

Sub PrintForms() 
    dim myID as integer 

'myID gets the last ID numer  
myID = sheets("CondForm").Range("A1").Value 

for i = 1 to myID 
    'this just takes the ID number from i and updates the worksheet with the data for that id 
    call misc.UpdateSheet(i) 
    Sheets("Data Form").PrintOut 
Next i 

End Sub 

但我需要所有的打印出來作爲一個打印作業，這樣，如果他們選擇了PDF格式，例如它會打印爲一個PDF文件，而不是數百個。

我也發現這種方法將打印一張紙張數組，但它仍然不讓我更新打印之間的紙張。

Sub PrintArray() 
    Dim SheetsToPrint As String 
    Dim MyArr()   As String 

SheetsToPrint = "Data Table,Data Form" 

'Split the string into an array 
MyArr = Split(SheetsToPrint, ",") 

ThisWorkbook.Worksheets(MyArr).PrintOut 

End Sub 

Answer 1

試試這個 - 調整原始數據 - 我在這段代碼中每20行假定不同的記錄。

Sub testit() 
Dim ws As Worksheet, lastRow As Long, originalWS As Worksheet 
Dim originalRowCounter As Long, wsRowCounter As Long, numberRecords As Long 
Dim i As Long 

    Application.ScreenUpdating = False 
    Set originalWS = ActiveSheet 
    Set ws = Sheets.Add 
    originalRowCounter = 1 
    wsRowCounter = 1 
    originalWS.Activate 

    ' Assume every 20 rows on originalWS has idividual record - adjust this accordingly 
    lastRow = originalWS.Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Row + 1 
    numberRecords = lastRow/20 
    For i = 1 To numberRecords 
     originalWS.Range("A" & originalRowCounter & ":K" & (originalRowCounter + 19)).Select 
     Selection.Copy 
     ws.Activate 
     ws.Range("A" & wsRowCounter).Activate 
     ActiveSheet.Paste 
     originalRowCounter = originalRowCounter + 20 
     wsRowCounter = wsRowCounter + 20 
     ws.Rows(wsRowCounter).PageBreak = xlPageBreakManual 
     originalWS.Activate 
    Next i 
    Application.PrintCommunication = False 
    With ws.PageSetup 
     .FitToPagesWide = 1 
     .FitToPagesTall = False 
    End With 
    Application.PrintCommunication = True 
    ws.PrintOut 
    Application.DisplayAlerts = False 
    ws.Delete 
    Application.DisplayAlerts = True 



Application.ScreenUpdating = True 
Set originalWS = Nothing 
Set ws = Nothing 
End Sub