Changing the active printer in a macro

[andy72685]

I have a macro that I use to change the fill color of cells, hide and unhide columns, and print 1 copy of each worksheet in the file. However, I need to manually select the printer and close out of the 'print' screen before I activate it. Otherwise, it will try to print from the other connected printer. Is there a line I can add to the macro to select the correct printer so I can JUST activate it without having to sidetrack?

Sheets("DRUFCS").Select
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = False
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("M:M").Select
    Selection.EntireColumn.Hidden = True
    Columns("N:N").Select
    Selection.EntireColumn.Hidden = True
    Columns("O:O").Select
    Selection.EntireColumn.Hidden = True
    Columns("P:P").Select
    Selection.EntireColumn.Hidden = True
    Columns("Q:Q").Select
    Selection.EntireColumn.Hidden = True
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("BURGLAR").Select
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = False
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = False
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("ANGLE").Select
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = False
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = False
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = True
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("CHANNEL").Select
    Columns("J:J").Select
    Selection.EntireColumn.Hidden = False
    Columns("H:H").Select
    Selection.EntireColumn.Hidden = False
    Columns("F:F").Select
    Selection.EntireColumn.Hidden = False
    Columns("D:D").Select
    Selection.EntireColumn.Hidden = False
    Columns("L:L").Select
    Selection.EntireColumn.Hidden = True
    Columns("K:K").Select
    Selection.EntireColumn.Hidden = True
    Columns("I:I").Select
    Selection.EntireColumn.Hidden = True
    Columns("G:G").Select
    Selection.EntireColumn.Hidden = True
    Columns("E:E").Select
    Selection.EntireColumn.Hidden = True
    Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("DRUFCS").Select
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Sheets("BURGLAR").Select
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Sheets("ANGLE").Select
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Sheets("CHANNEL").Select
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
End Sub

 

[Follicly Challenged]

Hello andy72685,

You will need a little more information to set the ActivePrinter. You need to know the printer's name and the port it uses.

Add a new VBA Module to workbook and paste the code below into it. Run the macro "ShowPrintersAndPorts". This will display a list of printers and faxes for the local computer.
Once you find the printer name and it's port you can change it using the method WBD posted.

New VBA Module Code

' Written:  August 05, 2017
' Authoer:  Leith Ross
' Summary:  Returns and array of printer names and port numbers on the user's computer.
'           The API calls in this module will work with both 64 bit and 32 bit Office running Windows 7 and higher.


Private Declare PtrSafe Function RegOpenKeyEx _
    Lib "Advapi32.dll" Alias "RegOpenKeyExA" _
        (ByVal hKey As LongPtr, _
         ByVal lpctstrSubKey As String, _
         ByVal ulOptions As Long, _
         ByVal samDesired As Long, _
         ByRef phKey As LongPtr) _
    As Long


Private Declare PtrSafe Function RegEnumValue _
    Lib "Advapi32.dll" Alias "RegEnumValueA" _
        (ByVal hKey As LongPtr, _
         ByVal dwIndex As Long, _
         ByVal lptstrValueName As String, _
         ByRef lpcchValueName As Long, _
         ByVal lpReserved As Long, _
         ByRef lpType As Long, _
         ByRef lpData As Byte, _
         ByRef lpcbData As Long) _
    As Long
   
Private Declare PtrSafe Function RegCloseKey _
    Lib "Advapi32.dll" _
        (ByVal hKey As LongPtr) _
    As Long
   
Private Declare PtrSafe Function FormatMessage _
    Lib "kernel32.dll" Alias "FormatMessageA" _
        (ByVal dwFlags As Long, _
         ByVal lpSource As Long, _
         ByVal dwMessageId As Long, _
         ByVal dwLanguageId As Long, _
         ByVal lptstrBuffer As String, _
         ByVal nSize As Long, _
         ByVal vaArguments As Any) _
    As Long
   
Private Sub DisplayError(ByVal Title As String, ByVal ErrorNumber As Long)
   
    Dim errMessage  As String
    Dim lenMessage  As Integer
    Dim msg         As String
    Dim retval      As Long
   
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
   
        lenMessage = 260
        errMessage = String(lenMessage, Chr(0))
       
        retval = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, ErrorNumber, 0&, errMessage, lenMessage, 0&)
        If retval > 0 Then
            msg = "Run-time error '" & ErrorNumber & "':" & vbLf & vbLf
            msg = msg & Left(errMessage, retval)
            MsgBox msg, vbExclamation + vbOKOnly, Title
        End If
       
End Sub


Private Function GetPrintersAndPorts() As Variant


    Dim Data()  As Byte
    Dim datType As Long
    Dim hKey    As LongPtr
    Dim index   As Long
    Dim lenData As Long
    Dim lenName As Long
    Dim prnData As Variant
    Dim prnName As String
    Dim prnPort As Variant
    Dim retval  As Long
    Dim strEnd  As Long
    Dim SubKey  As String
    Dim Text    As String
    Dim valName As String
   
    Const HKCU                  As Long = &H80000001
    Const KEY_READ              As Long = &H20019
    Const SUCCESS               As Long = 0
    Const ERROR_MORE_DATA       As Long = 234
    Const ERROR_NO_MORE_ITEMS   As Long = 259
       
        ReDim prnData(0)
       
        SubKey = "Software\Microsoft\Windows NT\CurrentVersion\PrinterPorts"


            retval = RegOpenKeyEx(HKCU, SubKey, 0&, KEY_READ, hKey)
            If retval <> 0 Then Call DisplayError("Cannot Open Registry Key", retval): Exit Function
       
            Do
Start:          ReDim Data(65535)
                lenName = 260
                valName = String(lenName, Chr(0))
                retval = RegEnumValue(hKey, index, valName, lenName, 0&, datType, Data(0), lenData)
                    Select Case retval
                        Case SUCCESS
                        Case ERROR_MORE_DATA: If Data(0) = 0 Then GoTo Start
                        Case ERROR_NO_MORE_ITEMS: Exit Do
                        Case Else: Call DisplayError("Printer Port Registry Error", retval): Exit Do
                    End Select
                index = index + 1
               
                Text = StrConv(Data, vbUnicode)
                strEnd = InStr(1, Text, Chr(0) & Chr(0)) - 1
                If strEnd > 0 Then
                    prnName = Left(valName, lenName)
                    prnPort = Split(Text, ",")(1)
                    prnData(index - 1) = prnName & " on " & prnPort
                    ReDim Preserve prnData(index)
                End If
            Loop
       
        retval = RegCloseKey(hKey)
       
        If retval <> SUCCESS Then
            Call DisplayError("Cannot Close Registry Key", retval)
        Else
            GetPrintersAndPorts = prnData
        End If
       
End Function


Public Sub ShowPrintersAndPorts()


    Dim msg      As String
    Dim Printer  As Variant
    Dim Printers As Variant
   
        Printers = GetPrintersAndPorts
   
        For Each Printer In Printers
            msg = msg & Printer & vbLf
        Next Printer
       
        MsgBox msg, vbOKOnly, "Printer Names and Ports"
       
End Sub

Thanks for this.
In the past, when Windows decided to change Ne numbers of my printers, while vba errored, I just changed the value while in debug from 00,01,02,03 and eventually it found it and I left it until Windows decided to change once again.
This time I couldn't figure out the value and thought "time to run some Mr Excel coding"
I ran the macro and lo and behold the magic numbers were revealed!
It was of course 00.
I had forgotten to start at 00.
Thanks for sharing the code.