Edit VBA code to print on as less pages as possible RRS feed

  • Question

  • Hi Everyone,

    I wrote a code (using online sources since I have little experience in VBA coding) but I would like some help to edit it and make it do what I need it to do (the part I couldn't find online)

    So what the code does is create page breaks so that the topic of a column does not get printed on multiple pages and if the rows are hidden, it does not print a blank page.

    Let's say I have 3 topics per page. I created checkboxes that allow the user to hide the topics that are not required. Let's say the user hides 2 topics from the first page (2nd and 3rd) so there is now only one topic on the first (1st) page and 3 topics on the second page (4th, 5th and 6th).

    What I want to do is set the limit (upper bound and lower bound of rows) for each topic and then if it fits, print it on the earliest page. So from the example, if the some topics from page 2 could fit on page 1, I would like it to move up and be printed on page one.

    Here is the code I am using now (which works great if there is no hidden row)



    Private Sub Print_Button_Click()
    Feuil1.Unprotect Password:=""
    Dim pb, i As Integer
    Dim CopiesCount As Long
    CopiesCount = Application.InputBox("Nombres de copie", Type:=1)

    pb = Array(7, 40, 63, 93)

    With ActiveSheet

        .ResetAllPageBreaks ' remove all page breaks from
        .PageSetup.PrintArea = "$B$7:$E$110"
        .PageSetup.FitToPagesWide = 1
        .PageSetup.Zoom = 75
        .PageSetup.Orientation = xlPortrait
        For i = LBound(pb) To UBound(pb)

            If .Rows(pb(i)).Hidden = True Then
            .HPageBreaks.Add Before:=.Cells(749, 1)
            .HPageBreaks.Add Before:=.Cells(pb(i), 1)
            .HPageBreaks.Add Before:=.Cells(111, 1)

            End If
        Next i
    For CopieNumber = 1 To CopiesCount
        .PrintPreview 'Change .PrintPreview to .PrintOut when tested
    Next CopieNumber
    End With
    Feuil1.Protect Password:="", AllowFormattingRows:=True
    End Sub


    I don't see how to upload a file, otherwise I would have uploaded my excel workbook

    Thank you,


    • Edited by kmoreau48 Monday, July 21, 2014 3:40 PM
    Monday, July 21, 2014 3:37 PM