How do I print a sheet for each week, adding week info to sheet

[AGreen17]

I have a log sheet that I would like to print for each week of the year, and have the week information on each sheet (see example). This is only for manual logging so I don't need to save the sheets and will not be entering any data into excel, my intention is the create a log book at the start of each year.

Thanks for your help.

 

[bobaol]

Hello AGreen17, will you please provide more details. what is the range of the sheet? A1 to Z14? or something like that? Do you want to print 52 pages of the image you're showing, except change the week header so that you will have a different paper sheet for each week? cheers!

 

[AGreen17]

The range is A1:R61, and yes, 52 pages of the same sheet with the week header changed for each sheet.

 

[Artik]

Assumptions for the code:
1. the code is run when the correct sheet is active.
2. All weeks of the indicated year are to be printed.
3. the area to be printed is to be A1:R61, in landscape orientation, the entire area must fit on one page.
4. the numbering of the weeks in accordance with the ISO standard.
5. in cell T1, enter the year for which the logbook is to be printed.
6. A print preview has been set up for testing. After testing, change the Preview parameter to False in line wks.PrintOut Preview:=... to print.

Sub PrintLogBook()
    Dim lYear As Long
    Dim DayNo As Long
    Dim strWeek As String
    Dim dtStartWeek As Date
    Dim dtEndWeek As Date
    Dim wks As Worksheet

    Set wks = ActiveSheet

    With wks.PageSetup
        .Orientation = xlLandscape    ' or xlPortrait
        .PrintArea = "$A$1:$R$61"
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With

    lYear = wks.Range("T1").Value
    DayNo = VBA.Weekday(DateSerial(lYear, 1, 1), vbMonday)

    dtStartWeek = DateSerial(lYear, 1, 1 - DayNo + 1)
    dtEndWeek = dtStartWeek + 6

    Do
        strWeek = vbNullString

        If Year(dtStartWeek) < lYear Then
            strWeek = Year(dtStartWeek) & "/" & IIf(Right(CStr(lYear), 1) = "0", Right(CStr(lYear), 2), Right(CStr(lYear), 1)) & " WEEK " & Evaluate("=ISOWEEKNUM(" & CLng(dtStartWeek) & ")")
        ElseIf Year(dtEndWeek) > lYear Then
            strWeek = Year(dtStartWeek) & "/" & IIf(Right(CStr(lYear + 1), 1) = "0", Right(CStr(lYear + 1), 2), Right(CStr(lYear + 1), 1)) & " WEEK " & Evaluate("=ISOWEEKNUM(" & CLng(dtStartWeek) & ")")
        Else
            strWeek = Year(dtStartWeek) & " WEEK " & Evaluate("=ISOWEEKNUM(" & CLng(dtStartWeek) & ")")
        End If

        strWeek = strWeek & "   " & UCase(Format(dtStartWeek, "MMM dd") & "-" & Format(dtEndWeek, "MMM dd"))

        wks.Range("R1").Value = strWeek

        wks.PrintOut Preview:=True    'after the test, change to False

        dtStartWeek = dtStartWeek + 7
        dtEndWeek = dtStartWeek + 6
        DoEvents
    Loop Until Year(dtStartWeek) > lYear

End Sub

Artik

 

[AGreen17]

Thanks Artik, I tried the code you provided and it seems to produce the sheets in the print preview, but they are all the same without the week header information changing for each sheet.. What would be needed to get the "YYYY WEEK # - MMM DD - MMM DD" to be shown and adjusted for each page?

 

[Artik]

You probably have merged cells in row 1.
Split the cells, or change the address of the cell where you want to insert the text in line: wks.Range("R1").Value = strWeek

Artik

 

[AGreen17]

That was it, works perfectly!
Thank you very much!