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

 

[wideboydixon]

There's a property of the Application object called ActivePrinter. You could just set that if you know the name of the printer:

Application.ActivePrinter = "My Epson Printer"

WBD

 

[Leith Ross]

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

 

[andy72685]

The port used is USB002. The name listed in the excel printer list is HP LaserJet Pro M402-M403 n-dne PCL 6. Do I make the code line application.activeprinter = USB002, or application.activeprinter = "HP LaserJet Pro M402-M403 n-dne PCL 6"

 

[wideboydixon]

Probably it would be:

Application.ActivePrinter = "HP LaserJet Pro M402-M403 n-dne PCL 6 on USB0002"

WBD

 

[andy72685]

Alright, I tried the full string, and just the printer name, and the port. All three errored me out. Do I need to define a variable first?

 

[Leith Ross]

Hello andy72685,

You need to include the colon ":" at the end of the string...

Application.ActivePrinter = "HP LaserJet Pro M402-M403 n-dne PCL 6 on USB0002:"

 

[andy72685]

Method 'ActivePrinter' of object '_Application' failed comes up when I include the colon at the end of the line. Any other thoughts?

 

[andy72685]

Leith Ross - When you said I needed the printer name and port, I accessed the devices and printers instead of running the macro, and when I saw on USB0002, it stood to reason that that was the port. I ran the macro just now, and it gave a completely different port. Ne02. Replacing USB0002 with that solved the issue. Thanks for your help!

 

[Leith Ross]

Hello Andy,

You're welcome. Glad you have everything working now.