Forum Discussion

az123330's avatar
az123330
Copper Contributor
Jun 18, 2019

Macro to print double sided

Hi,

 

I have created the attached spreadsheet and inserted the basic macro where it will print multiple sheets from and to the date range I specify in the macro. This is to act as a register and saves times copying and pasting the date each and every time.

 

The issue I am having is the sheets will not print duplex no matter what I do. I have tried changing the default printer and even put code in to select the printer before it prints the sheets. In setup duplex is selected but still comes out as single sheets.

 

Does anyone have an idea whats wrong?

 

The alternative is to change the macro so it does the same thing but instead prints all sheets into one PDF file. From there I can print however I do not know how to write this code?

 

Thanks in advance

developer
excel
Macros and VBA

7 Replies

Sort By
  • JKPieterse's avatar
    JKPieterse
    Silver Contributor
    Jun 18, 2019

    az123330 The problem is that your macro sends out a new printcommand for each date, which the printer then immediately processes. If the sheet would be larger so there are two pages to print, I bet those would be printed in duplex. Here is a macro that appears to do the trick. It creates temporary copies of the worksheet, enters the date into them and then prints all of them in one go and subsequently deletes the copies:

    Sub PrintAllDates()
    Dim vSheets() As Variant
    Dim printDate As Date
    Dim startDate As Date
    Dim endDate As Date
    Dim lShtCt As Long
    ReDim vSheets(1 To 1)
    Application.Dialogs(xlDialogPrinterSetup).Show
    Application.ScreenUpdating = False
    startDate = "18/06/19"
    endDate = "19/06/19"
    For printDate = startDate To endDate
        ActiveSheet.Range("C1") = printDate
        lShtCt = lShtCt + 1
        ReDim Preserve vSheets(1 To lShtCt)
        vSheets(lShtCt) = ActiveSheet.Name
        ActiveSheet.Copy ActiveSheet
    Next
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Sheets(vSheets).Select
    Application.ScreenUpdating = False
    ActiveWindow.SelectedSheets.PrintOut
    'New delete the temporary sheets
    ' Make a list of them by removing the first sheet from the list (since that is our original)
    For lShtCt = LBound(vSheets) To UBound(vSheets) - 1
        vSheets(lShtCt) = vSheets(lShtCt + 1)
    Next
    ReDim Preserve vSheets(1 To lShtCt - 1)
    'Now delete
    Sheets(vSheets).Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
End Sub

     

    • az123330's avatar
      az123330
      Copper Contributor
      Jun 18, 2019

      JKPieterse 

       

      Thats fantastic! I really need to learn how to code on this. Works exactly as intended.

       

      A bit of an out the box question but do you know if I can somehow have it so it skips weekends throughout the year? The register is only meant for Mon-Fri and since its double sided I can't just get rid of the weekends because they end up printing on the same page as the weekdays.

       

      Thanks again

      • JKPieterse's avatar
        JKPieterse
        Silver Contributor
        Jun 18, 2019

        az123330 You can omit weekends like so:

        Sub PrintAllDates()
    Dim vSheets() As Variant
    Dim printDate As Date
    Dim startDate As Date
    Dim endDate As Date
    Dim lShtCt As Long
    ReDim vSheets(1 To 1)
    Application.Dialogs(xlDialogPrinterSetup).Show
    Application.ScreenUpdating = False
    startDate = "15/06/19"
    endDate = "19/06/19"
    For printDate = startDate To endDate
        If Weekday(printDate, vbMonday) < 6 Then
            ActiveSheet.Range("C1") = printDate
            lShtCt = lShtCt + 1
            ReDim Preserve vSheets(1 To lShtCt)
            vSheets(lShtCt) = ActiveSheet.Name
            ActiveSheet.Copy ActiveSheet
        End If
    Next
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    Sheets(vSheets).Select
    Application.ScreenUpdating = False
    ActiveWindow.SelectedSheets.PrintOut
    'New delete the temporary sheets
    ' Make a list of them by removing the first sheet from the list (since that is our original)
    For lShtCt = LBound(vSheets) To UBound(vSheets) - 1
        vSheets(lShtCt) = vSheets(lShtCt + 1)
    Next
    ReDim Preserve vSheets(1 To lShtCt - 1)
    'Now delete
    Sheets(vSheets).Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
End Sub

Resources