Question

我正在尝试多次打印同一个工作表作为一个打印作业。我的工作表包含一个包含ID，FirstName，LastName和Age列的表格。我有另一个工作表，就像一个表单。用户选择一个ID，其余列将自动填充（First Name, LastName, and Age）。我已经有了一些代码，一旦用户从下拉列表中选择了他们想要的ID，该工作表就会自动更新该ID的信息。我正在尝试添加一个宏，它将为每个ID打印相同的工作表。所以，如果我有2个id，例如：

代码将使用我现有的宏来更新ID1
打印工作表
使用我的代码更新ID2
打印工作表

最后，我想要一个包含两张纸的打印作业。

我已经知道我可以使用下面的代码单独打印工作表：

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

在一个作业中多次打印相同的工作表

1 个答案: