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"
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
Application.ActivePrinter = currentPrinter
End Sub
Public Function FindPrinter(ByVal printerName As String) As String
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
printer = Device & " on " & Split(RegValue, ",")(1)
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