Print sheets based on checkbox

[imcl75]

I want to be able to print specific sheets within a workbook based on whether certain checkboxes are checked. I have a workbook with 10 sheets that I want to print between 1 and all of them based on whether a box is checked. I have created a selector sheet with 10 checkboxes (one for each sheet I may need to print). I want to be able to select, say, checkbox 1,2,5,8 and then that print the 4 specific sheets. I am a primary school teacher and I have created worksheets which have questions for children to practise / revise. I want to easily be able to print out different sheets by selecting what types of questions the child needs to practise. Each of the 'question types' below has a sheet in the workbook. Any help very much appreciated

 

[John_w]

Try this macro. The sheet containing the print selector table should be named "Print Selector" - change the code if yours is different. The checkboxes should be Form Control checkboxes (not Activex) and each should be placed wholly in the table column 2 cell - a warning is displayed if the macro can't find the checkbox for a row, in which case you would have to reposition the checkbox or reduce its size or increase the row height.

Public Sub Print_Sheets_Based_On_Checkboxes()

    Dim printTable As ListObject
    Dim r As Long
    Dim printCheckbox As CheckBox
    
    Set printTable = ThisWorkbook.Worksheets("Print Selector").ListObjects(1)
    
    With printTable
        For r = 1 To .DataBodyRange.Rows.Count
            Set printCheckbox = Get_Form_Checkbox(.DataBodyRange(r, 2))
            If Not printCheckbox Is Nothing Then
                If printCheckbox.Value = 1 Then
                    ThisWorkbook.Worksheets(CStr(.DataBodyRange(r, 1))).PrintOut Copies:=1
                End If
            Else
                MsgBox "Print checkbox for " & .DataBodyRange(r, 1) & " not found wholly in cell " & .DataBodyRange(r, 2).Address(False, False), vbExclamation
            End If
        Next
    End With

End Sub


Private Function Get_Form_Checkbox(inCell As Range) As CheckBox

    Dim cb As CheckBox
    
    Set Get_Form_Checkbox = Nothing
    For Each cb In inCell.Worksheet.CheckBoxes
        If Not Intersect(inCell, cb.TopLeftCell, cb.BottomRightCell) Is Nothing Then
            Set Get_Form_Checkbox = cb
            Exit Function
        End If
    Next

End Function

 

[imcl75]

hi - sorry for the slow reply. This worked great for me. Really appreciate your help! Is there a way to force double-sided printing for these pages? thanks again

 

[John_w]

For double-sided printing, you should first add a Windows printer and set its printer properties to print on 2 sides.

Then use this code instead of the previous code. The name of your double-sided printer is specified in the WindowsPrinterName string.

Public Sub Print_Sheets_Based_On_Checkboxes_Specific_Printer()

    Dim printTable As ListObject
    Dim r As Long
    Dim printCheckbox As CheckBox
    Dim currentPrinter As String
    Dim WindowsPrinterName As String
    Dim NEPrinterName

    currentPrinter = Application.ActivePrinter
    
    WindowsPrinterName = "Your double-sided printer name"

    'Get the full name of the printer, including its NExx: network port, and make it the active printer
    
    NEPrinterName = FindPrinter(WindowsPrinterName)
    Application.ActivePrinter = NEPrinterName
    
    Set printTable = ThisWorkbook.Worksheets("Print Selector").ListObjects(1)
    
    With printTable
        For r = 1 To .DataBodyRange.Rows.Count
            Set printCheckbox = Get_Form_Checkbox(.DataBodyRange(r, 2))
            If Not printCheckbox Is Nothing Then
                If printCheckbox.Value = 1 Then
                    ThisWorkbook.Worksheets(CStr(.DataBodyRange(r, 1))).PrintOut Copies:=1
                End If
            Else
                MsgBox "Print checkbox for " & .DataBodyRange(r, 1) & " not found wholly in cell " & .DataBodyRange(r, 2).Address(False, False), vbExclamation
            End If
        Next
    End With

    'Restore current printer
    
    Application.ActivePrinter = currentPrinter

End Sub


'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Public Function FindPrinter(ByVal printerName As String) As String

    'This works with Windows 2000 and up
    
    Dim Arr As Variant
    Dim Device As Variant
    Dim Devices As Variant
    Dim printer As String
    Dim RegObj As Object
    Dim RegValue As String
    Const HKEY_CURRENT_USER = &H80000001
    
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
    
    For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        'Debug.Print Device
        printer = Device & " on " & Split(RegValue, ",")(1)
        'If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then  'original code
        If StrComp(Device, printerName, vbTextCompare) = 0 Then
            FindPrinter = printer
            Exit Function
        End If
    Next
      
End Function


Private Function Get_Form_Checkbox(inCell As Range) As CheckBox

    Dim cb As CheckBox
    
    Set Get_Form_Checkbox = Nothing
    For Each cb In inCell.Worksheet.CheckBoxes
        If Not Intersect(inCell, cb.TopLeftCell, cb.BottomRightCell) Is Nothing Then
            Set Get_Form_Checkbox = cb
            Exit Function
        End If
    Next

End Function