Changing the active printer in a macro

A

andy72685

Board Regular
Joined
Oct 20, 2016
Messages
72
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?

Code: 
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
 
Last edited by a moderator:

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
There's a property of the Application object called ActivePrinter. You could just set that if you know the name of the printer:

Code: 
Application.ActivePrinter = "My Epson Printer"

WBD
 
Upvote 0
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
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
 
Upvote 0
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"
 
Upvote 0
Probably it would be:

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

WBD
 
Upvote 0
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?
 
Upvote 0
Hello andy72685,

You need to include the colon ":" at the end of the string...
Code: 
Application.ActivePrinter = "HP LaserJet Pro M402-M403 n-dne PCL 6 on USB0002:"
 
Last edited:
Upvote 0
Method 'ActivePrinter' of object '_Application' failed comes up when I include the colon at the end of the line. Any other thoughts?
 
Upvote 0
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!
 
Upvote 0
Hello Andy,

You're welcome. Glad you have everything working now.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Solved
Macro - Columns Are not Hidding / unhiding correctly
Replies
4
Views
433
GarethCW
G
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
264
rlv01
R
JohnZ1156
  • Solved
VBA Macro to print table rows from a start date to an end date.
Replies
4
Views
318
Joe4
Joe4
J
  • Question Question
Macro to affect cell background color
Replies
3
Views
404
mumps
mumps
P
  • Question Question
Help with Vba Code
Replies
3
Views
464
Coyotex3
C

Forum statistics

Threads
1,223,909
Messages
6,175,315
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top