1つのジョブで同じワークシートを複数回印刷する

Question

1つの印刷ジョブと同じワークシートを複数回印刷しようとしています。私は、列がID,FirstName,LastName、Ageのテーブルを持つワークシートを持っています。フォームのように機能する別のワークシートがあります。 ユーザーはIDを選択し、残りの列は自動的に入力されます（First Name, LastName, and Age）。 私はすでに、ユーザーがドロップダウンからどのIDを選択すれば、シートはそのIDの情報で自動的に更新されるというコードを持っています。 IDごとに同じワークシートを印刷するマクロを追加しようとしています。

2. がID2でワークシートを更新するために、自分のコードを使用し
3. 印刷にID1とワークシートをワークシートを更新するために、私の既存のマクロを使用するコード
4. 印刷：もしそうなら、私は、例えば2 IDを持っていましたワークシート

最後に、両方のシートを含む1つの印刷ジョブを持っていたいと思います。

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ファイルを選択した場合、それを取得するように、私は1つの印刷ジョブとして出てくる印刷物のすべてを必要とする：

私はすでに私がワークシートを印刷するには、以下のコードを使用することができます知っているが分離します数百ではなく1つの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