Print Macro

JohnSlider

New Member
Joined
Nov 23, 2015
Messages
41
Code:
Sub test()Dim rng As Range
Dim wks As Worksheet


For Each rng In Sheets("Dropdowns").Range("B12:B29")
    If Trim(rng.Value) <> "" Then
        On Error Resume Next
        Set wks = Nothing
        Set wks = Sheets(rng.Value)
        On Error GoTo 0
        If wks Is Nothing Then
            MsgBox "Sheet " & rng.Value & " does not exist"
        Else
            wks.PrintOut
        End If
    End If
Next rng
End Sub

Hello!

So the above macro will print sheets whose names appear in cells within the range of B12:B19 on sheet Dropdowns.

It works a little wonky, in that it will jump to each sheet and print them separately, but I suppose I can live with that.

However, I would like to add a couple features.

1) I would like to be able to designate within a cell on sheet Print how many copies to print out.
2) I would like for it to print double sided.
3) I would like it to print collated.

Are these features that can be built into the above macro? Or perhaps one of you wizards have an even better macro that I should be using. :)
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
You may want to use the macro recorder and record a manual print using the page layout tab. You will see all the options that can be "played with".
 
Upvote 0
I'm pretty novice to Macro coding so I'm not sure I could pull that off.

Do you know if this option would still allow me to print whatever sheets are listed in B12:B19, because the sheets listed does change based on what information is filled in the workbook.
 
Upvote 0
Do you know how to record a macro?
 
Upvote 0
Better yet, here is a very generic recorded print macro.

Perhaps you could work this into your existing code, as per your requirements...

Code:
Sub Macro1()
'
' Macro1 Macro
'


'
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = -4
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub
 
Upvote 0
Hi igold --

I am not familiar with macro recorder. To be honest, I'm more of a formula guy. I can normally use a string of formulas to accomplish what I need to, but this is obviously not possible with printing.

I've tried taking the sample macro above and modifying it, but I don't see how I can make it collate, print tabs listed in a certain range (B12:B29), or print a certain number of copies stipulated in a cell (C12).

I need this for work and am willing to PayPal some money for somebody's time to help me out.

Thanks!
 
Upvote 0
Hi John,

As money is the ultimate motivator, I do this because I honestly enjoy helping people.

That said, I will not be able to look at this for a little while (hopefully today though). If in that time someone PM's you and offers to do this for the pay, would you kindly post back that a solution is no longer needed so that I do not take the time just to duplicate someone else's work.

Regards,

igold
 
Upvote 0
Hi John,

As it turns out, getting Excel to print duplex through VBA is not as straightforward as I thought it would be. I did a lot of research and there does not seem to be a easy way to do it. I found some code but for the most part it gets pretty complicated.

I don't know how big your print jobs usually are, but the best work around seems to be that your default active printer be set to always print in duplex. If that is not doable, then the next workaround would be to set the sheets to print duplex at the time of printing. Another thing I do not know is if you can set the printer to print duplex on the first page or does it have to be done for every page. To get to the printer setup page is a single line of code, as such here are three different codes. Pehaps one of them will get you closer to where you need to be. Also, maybe one of the more fluent members of the forum will jump in and bail us out. :)

The names of the subs should explain what each one does...

Code:
Sub Printer_Default_is_Duplex()


    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim pts
    Dim i As Integer, cpys As Integer
    Dim prntr As String
    
    cpys = ws.Range("C12")
    pts = ws.Range("B12:B29")
    For i = LBound(pts) To UBound(pts)
        If Not pts(i, 1) = "" Then
            With Worksheets(pts(i, 1))
                .PrintOut Copies:=cpys, Collate:=True
            End With
        End If
    Next
    
End Sub
or


Code:
Sub Show_Dialog_For_First_Sheet_Only()


    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim pts
    Dim i As Integer, cpys As Integer
    Dim prntr As String
    
    cpys = ws.Range("C12")
    pts = ws.Range("B12:B29")
    Application.Dialogs(xlDialogPrint).Show , , , , , , , , , , , 1
    For i = LBound(pts) To UBound(pts)
        If Not pts(i, 1) = "" Then
            With Worksheets(pts(i, 1))
                .PrintOut Copies:=cpys, Collate:=True
            End With
        End If
    Next
    
End Sub

or


Code:
Sub Show_Dialog_For_All_Sheets()


    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim pts
    Dim i As Integer, cpys As Integer
    Dim prntr As String
    
    cpys = ws.Range("C12")
    pts = ws.Range("B12:B29")
    For i = LBound(pts) To UBound(pts)
        If Not pts(i, 1) = "" Then
            With Worksheets(pts(i, 1))
                Application.Dialogs(xlDialogPrint).Show , , , , , , , , , , , 1
                .PrintOut Copies:=cpys, Collate:=True
            End With
        End If
    Next
    
End Sub
I hope this helps some...
 
Upvote 0
Hello igold --

Thank you! Unfortunately it still does not collate. I'm guessing because it is launching a separate print action for each tab?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top