CODEWITHSUNDEEP
vbaexcelprinting
Aspiring Developer
Aspiring Developer

Reputation: 680

VBA Printing in Groups of 4 Rows

I have a pretty specific spreadsheet that contains the wages/bonuses of all employees. Each employee has 4 rows to themselves (Salary / Bonus / Salary % Delta / Bonus as % of Salary). The problem I'm having is that some managers have their employees cutoff if it goes to multiple pages so I switched it to fit 1 x 1 but now obviously it is too condensed. Is there a way to have the macro print in groups of 4 rows? Or perhaps make it so it prints 4 rows for each employee on the same page (salary/bonus/salary % delta/bonus as % of salary) Thank you in advance!

Private Sub CommandButton1_Click()
Dim Sel_Manager As String
'Specify headers to be repeated at the top
With ActiveSheet.PageSetup
        .PrintTitleRows = "$5:$10"
        .PrintTitleColumns = "$B:$M"
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
End With

'Manager selection through simple Inputbox
 Sel_Manager = ComboBox1
'Insert autofilter for worksheet
Cells.Select
Selection.AutoFilter
'Select manager defined in inputbox
ActiveSheet.Range("B10", Range("M10").End(xlDown)).AutoFilter Field:=1, Criteria1:=Sel_Manager
 'Select range to be printed and specify manager in filename
ActiveSheet.Range("B10", Range("M10").End(xlDown)).Select

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Sel_Manager + ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

  ActiveSheet.ShowAllData

End Sub

Upvotes: 0

Views: 143

Answers (1)

Limak
Limak

Reputation: 1521

I think I have better solution for you. You can just split your print area on pages, every x rows. Take a look at this example, where every page have 100 rows:

LastRow = Sheets("Raport").Range("B" & Rows.Count).End(xlUp).Row
Sheets("Raport").PageSetup.PrintArea = "$A$1:$G$" & LastRow

t = 4 ' number of title rows
r = 96 ' number of rows on one page (without title rows)
nPages = Application.RoundUp((LastRow - 4) / 96, 0) 'nPages gives you number of pages. 
Sheets("Raport").ResetAllPageBreaks
Sheets("Raport").VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 ' this may not be necessary for your data

On Error Resume Next
If nPages > 1 Then
    For i = 1 To nPages - 1
        ActiveSheet.HPageBreaks.Add Before:=ActiveSheet.Range("A" & 5 + i * 96)
        Set ActiveSheet.HPageBreaks(i).Location = Range("A" & 5 + i * 96)
    Next i
Else
    ActiveSheet.HPageBreaks(1).DragOff Direction:=xlDown, RegionIndex:=1
End If
On Error GoTo 0

Upvotes: 1

Related Questions