CODEWITHSUNDEEP
vbaexcel
user8139445
user8139445

Reputation:

VBA Macro Printing loop

[update below]

I have been trying to write a printing macro for my production sheet.

Everything but the actual printouts work great. If I use .Zoom = False instead of .Zoom = 50, the printarea ends up tiny on the printout sheet. If I use zoom=50, I get these inch wide margins to the left and right. What I suspect is that it somehow doesn't process the actual printarea line, but I have no clue why since the other command lines seem to work just fine. I tried to strip the code down to pretty much printarea, fitTopagesxx, and got the same issue.

I tried rewriting the code multiple times now and either get an error prompt or the same results with the other code found on the web.

   Sub PrintJob()
        Dim ws As Worksheet
        Dim i As Long

    Set ws = Sheets("Filtered_List")

        For i = 2 To ws.Cells(Rows.Count, "F").End(xlUp).Row
        If ws.Cells(i, "F").Value = 0 Then Exit For
            With Sheets("Print_Page")
                .Range("C8").Value = ws.Cells(i, "F").Value
                Worksheets("Print_Page").PageSetup.PrintArea = "$C$2:$L$60"
                Worksheets("Print_Page").PageSetup.Orientation = xlPortrait
                Worksheets("Print_Page").PageSetup.Zoom = 50
                Worksheets("Print_Page").PageSetup.FitToPagesWide = 1
                Worksheets("Print_Page").PageSetup.FitToPagesTall = False
                Worksheets("Print_Page").PageSetup.LeftMargin = Application.InchesToPoints(0)
                Worksheets("Print_Page").PageSetup.RightMargin = Application.InchesToPoints(0)
                Worksheets("Print_Page").PageSetup.TopMargin = Application.InchesToPoints(0)
                Worksheets("Print_Page").PageSetup.BottomMargin = Application.InchesToPoints(0)
                Worksheets("Print_Page").PageSetup.HeaderMargin = Application.InchesToPoints(0)
                Worksheets("Print_Page").PageSetup.FooterMargin = Application.InchesToPoints(0)
                .PrintOut
            End With
    Next i
End Sub

[Update:] I figured out the problem after some help here after finding out it was a sheet specific error. Basically, the print title fields need to be empty and that code that does that is this one:

.PrintTitleRows = ""
.PrintTitleColumns = ""

I added a few lines more an used the cleaned up code from Noldor130884:

Sub PrintJob()
    Dim ws As Worksheet
    Dim i As Long

    Set ws = Sheets("Filtered_List")

        For i = 2 To ws.Cells(Rows.Count, "F").End(xlUp).Row
        If ws.Cells(i, "F").Value = 0 Then Exit For
            With Worksheets("Print_Page")
            .Range("C8").Value = ws.Cells(i, "F").Value
                With .PageSetup
                .PrintArea = "$C$2:$L$60"
                .Orientation = xlPortrait
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = False
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0)
                .FooterMargin = Application.InchesToPoints(0)
                .PrintTitleRows = ""
                .PrintTitleColumns = ""
                .LeftHeader = ""
                .CenterHeader = ""
                .RightHeader = ""
                .LeftFooter = ""
                .CenterFooter = ""
                .RightFooter = ""
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0)
                .BottomMargin = Application.InchesToPoints(0)
                .HeaderMargin = Application.InchesToPoints(0)
                .FooterMargin = Application.InchesToPoints(0)
                .PrintHeadings = False
                .CenterHorizontally = True
                .CenterVertically = False
                .PaperSize = xlPaperLetter

                End With
                .PrintPreview
        End With
    Next i
End Sub

Hope that saves someone a bit of a headache.

Upvotes: 2

Views: 5542

Answers (1)

Noldor130884
Noldor130884

Reputation: 1004

First of all, let me correct your code a bit: 

With Worksheets("Print_Page")
    .Range("C8").Value = ws.Cells(i, "F").Value
    With .PageSetup
        .PrintArea = "$C$2:$L$60"
        .Orientation = xlPortrait
        .Zoom = 50
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
    End With
    .PrintOut
End With

Now, please notice that as Microsoft says, Zoom = False means that "the FitToPagesWide and FitToPagesTall properties control how the worksheet is scaled.".

In your code you are using a Zoom before those 2 properties, therfore you are overwriting.

If I understood correctly what you want to do, please just remove from your code:

.FitToPagesWide = 1
.FitToPagesTall = False

Upvotes: 2

Related Questions