如何在循环中将多个页面打印到一个pdf

Question

I am trying to create macro for printing daily planner. One page for each day. I have created some kind of template and now, each time code run trough for cycle, it changes date and week number etc. and then print the page. However like this is every page in different pdf file. Is there some way, how to add each time new page to the same pdf (same range, but different data) and then print?

For i = 1 To 365

ActiveSheet.PrintOut

Range("A26") = WorksheetFunction.RoundUp((i + 2) / 7, 0) & ". week" 'week number

Range("A1").Value = Range("A1").Value + 1  'change date

Range("A1").Select
If (i Mod 2 = 0) Then
    Selection.HorizontalAlignment = xlLeft 'left page
Else
    Selection.HorizontalAlignment = xlRight 'right page
End If

Next i

Answer 1

I have amended your macro so that it first creates a new temporary workbook in which to copy each updated worksheet. Then it uses the ExportAsFixedFormat method to print the workbook to the specified PDF file (change the filename accordingly). Then it deletes the temporary workbook. Note that ScreenUpdating is set to False at the beginning of the code so that all this happens in the background. Also, it is assumed that the template sheet is the active sheet.

Option Explicit

Sub PrintDailyPlanner()

    Dim sourceWS As Worksheet
    Dim tempWB As Workbook
    Dim i As Long

    Application.ScreenUpdating = False

    'set the active sheet
    Set sourceWS = ActiveSheet

    'create a new temporary workbook with one worksheet
    Set tempWB = Workbooks.Add(Template:=xlWBATWorksheet)

    'copy the source worksheet each time it's updated to the newly created temporary workbook
    With sourceWS
        For i = 1 To 365

            .Range("A26") = WorksheetFunction.RoundUp((i + 2) / 7, 0) & ". week" 'week number

            .Range("A1").Value = .Range("A1").Value + 1  'change date

            If (i Mod 2 = 0) Then
                .Range("A1").HorizontalAlignment = xlLeft 'left page
            Else
                .Range("A1").HorizontalAlignment = xlRight 'right page
            End If

            .Copy after:=tempWB.Worksheets(tempWB.Worksheets.Count)

        Next i
    End With

    'delete the first worksheet from the temporary workbook
    Application.DisplayAlerts = False
    tempWB.Worksheets(1).Delete
    Application.DisplayAlerts = True

    'print the temporary workbook to PDF file (change the filename accordingly)
    tempWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Domenic\Desktop\sample.pdf"

    'close the temporary workbook, without saving
    tempWB.Close SaveChanges:=False

    Application.ScreenUpdating = True

End Sub

Hope this helps!