Call Sub using Print Range Variables

[Clintster]

I needed a sub that could be used for various range on various sheets. each sheet has different buttons to initiate a print dependant on parameters in the Action for the button sub. It took a few days and several headaches to figure it out. There may be other short cuts but this does work.

I was also able to change the page orientation and keep original rows and cols with the last two parameters in the sub call.


Sub PrintRnd1()
Dim PrtFirstRow, PrtFirstCol, PrtLastCol, PrtLastRow As Integer
Dim CountTeams As Integer
Dim MyPrintTitle As String
Call DeleteButton("AllDraw")
CountTeams = 2
Do While True
Range("E" & CountTeams & "").Select
If ActiveCell <> "" Then
CountTeams = CountTeams + 1
Else
Exit Do
End If
Loop
PrtFirstRow = 1
PrtFirstCol = 5
PrtLastCol = 9
PrtLastRow = CountTeams - 1
MyPrintTitle = "Round 1"
Call PrintSheet(PrtFirstRow, PrtFirstCol, PrtLastRow, PrtLastCol, MyPrintTitle, 0, 0)
End Sub
-------------------------
Sub PrintSheet(FRow, FCol, LRow, LCol, PrintTitle, KeepRowCol, PaperOrient)
Dim GoPrint, MyCopies, MyFRow, MyFCol As Integer
MyFRow = FRow
MyFCol = FCol

If KeepRowCol = 0 Then
For i = 1 To LCol
LRow = Range(Cells(600, i), Cells(600, i)).End(xlUp).Row
If LRow > FRow Then
FRow = LRow
FCol = i
End If
Next i
End If
If PaperOrient = 0 Then
MyOrient = xlPortrait
Else
MyOrient = xlLandscape
End If
LastCell = Range(Cells(LRow, LCol), Cells(LRow, LCol)).Address
FirstCell = Range(Cells(MyFRow, MyFCol), Cells(MyFRow, MyFCol)).Address
ActiveSheet.PageSetUp.PrintArea = FirstCell & ":" & LastCell
Range("" & FirstCell & ":" & LastCell & "").Select
Application.PrintCommunication = False
With ActiveSheet.PageSetUp
.LeftHeader = ""
.CenterHeader = PrintTitle
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "" '"&""Agency FB,Bold""&8 5"
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = True
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = MyOrient 'xlLandscape or xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False 'must be false when FitToPages variables are used
.FitToPagesWide = 1 ' else zoom = 100 and fittopages is removed or commented out
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
Application.PrintCommunication = True
GoPrint = MsgBox("Are you ready to PRINT?", vbYesNo, "Print Now!")
If GoPrint = 6 Then
MyCopies = 0
MyCopies = InputBox("Number of Copies Needed." & vbCr & "Enter Number")
If MyCopies > 0 Then
ActiveWindow.SelectedSheets.PrintOut Copies:=MyCopies, Collate:=True, _
IgnorePrintAreas:=False
End If
End If
ActiveSheet.PageSetUp.PrintArea = ""
End Sub