Checking printer is connected / available in VBA

M

mps

New Member
Joined
Feb 7, 2011
Messages
42
I have a VBA macro which asks the user to chose which columns they want printing on a worksheet and then prints the worksheet (code below). The only problem is that it seems if the printer is not connected for any reason then Excel will crash. I have a printer that is connected by wifi and sometimes it does not recognise the printer is available and therefore Excel crashes. Is there any way in VBA to check if a printer is connected and available to stop the Excel crashing?

(I am using Excel 2010 on Windows 7 64bit)

Code: 
Sub Button95_Click()
'-------------------------------------------
'Product Search Results Print Button Clicked
'-------------------------------------------
Dim lastrow As Integer
Dim oldprinter As String
Application.ScreenUpdating = False
Application.EnableEvents = False 'turn off events
'unfreeze rows
Sheet13.Activate
ActiveWindow.FreezePanes = True

Sheet13.Unprotect
Sheet13.Columns(3).NumberFormat = "###0.00"
Sheet13.Protect
'setup userform ready to ask user what columns to print
UserForm13.printitemcodebox = True
UserForm13.printdescriptionbox = True
UserForm13.printitempricebox = True
UserForm13.printtaxcodebox = False
UserForm13.printdealcodebox = False
UserForm13.printqtydeliveredbox = False
UserForm13.printqtyinstockbox = True
UserForm13.printqtysoldbox = False
UserForm13.printdescription2box = True
UserForm13.printdescription3box = True
'ask user what columns to print
UserForm13.Show
'hide relevant columns before printing
Sheet13.Unprotect
Sheet13.Columns(1).EntireColumn.Hidden = Not UserForm13.printitemcodebox
Sheet13.Columns(2).EntireColumn.Hidden = Not UserForm13.printdescriptionbox
Sheet13.Columns(3).EntireColumn.Hidden = Not UserForm13.printitempricebox
Sheet13.Columns(4).EntireColumn.Hidden = Not UserForm13.printtaxcodebox
Sheet13.Columns(5).EntireColumn.Hidden = Not UserForm13.printdealcodebox
Sheet13.Columns(6).EntireColumn.Hidden = Not UserForm13.printqtydeliveredbox
Sheet13.Columns(7).EntireColumn.Hidden = Not UserForm13.printqtyinstockbox
Sheet13.Columns(8).EntireColumn.Hidden = Not UserForm13.printqtysoldbox
Sheet13.Columns(9).EntireColumn.Hidden = Not UserForm13.printdescription2box
Sheet13.Columns(10).EntireColumn.Hidden = Not UserForm13.printdescription3box
Sheet13.Protect
Err.Clear
On Error Resume Next
oldprinter = Application.ActivePrinter
On Error GoTo 0
If Err.Number <> 0 Then Call MsgBox("Print Error!", vbDefaultButton1 Or vbExclamation, ""): Exit Sub
lastrow = Sheet13.Range("A" & LTrim(Str(maxrows))).End(xlUp).Row
Application.ScreenUpdating = False
With Worksheets("Product Search Results").PageSetup
        .FitToPagesWide = 1
        .Zoom = False
        .PrintArea = "A2:J" & LTrim(Str(lastrow))
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .PrintGridlines = True
        .BlackAndWhite = True
        .Orientation = xlPortrait
        .PrintHeadings = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .PrintErrors = xlPrintErrorsDisplayed
        .CenterHeader = "Product Search Results" & Chr(13) & "&p of &n  &T &D" 'header
'        .CenterFooter = "" 'page numbers and time / date report printed in the footer
End With
Application.ScreenUpdating = True
Err.Clear
On Error Resume Next
Application.Dialogs(xlDialogPrint).Show
On Error GoTo 0
If Err.Number <> 0 Then Call MsgBox("Print Error!", vbDefaultButton1 Or vbExclamation, "")
Application.ActivePrinter = oldprinter 'make sure if user changes printer we set back to default printer
Worksheets("Product Search Results").PageSetup.CenterHeader = "" 'clear page header
Worksheets("Product Search Results").PageSetup.CenterFooter = "" 'clear page footer
Call clearpagebreaks 'make sure we are not showing page breaks after printing
Application.ScreenUpdating = False
'make sure all columns are visible
Sheet13.Unprotect
Sheet13.Columns(1).EntireColumn.Hidden = False
Sheet13.Columns(2).EntireColumn.Hidden = False
Sheet13.Columns(3).EntireColumn.Hidden = False
Sheet13.Columns(4).EntireColumn.Hidden = False
Sheet13.Columns(5).EntireColumn.Hidden = False
Sheet13.Columns(6).EntireColumn.Hidden = False
Sheet13.Columns(7).EntireColumn.Hidden = False
Sheet13.Columns(8).EntireColumn.Hidden = False
Sheet13.Columns(9).EntireColumn.Hidden = False
Sheet13.Columns(10).EntireColumn.Hidden = False
Sheet13.Protect
'freeze top two rows
Sheet13.Rows(2).EntireRow.Select
ActiveWindow.FreezePanes = True
Sheet13.Range("A3").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Sort by date Sort by votes
[Solved] Re: Checking printer is connected / available in VBA

After some more experimenting I finally solved the problem of Excel crashing when choosing a printer using the print dialog. The solution seemed to be to replace dialogs(xldialogprint).show with:

Code: 
 Application.Dialogs(xlDialogPrinterSetup).Show
 Range("A2:J" & LTrim(Str(lastrow))).PrintOut

Using the printer setup dialog enables the user to choose a printer to use. You then have to print manually to this printer. This seems to stop Excel crashing if the chosen printer / default printer is not attached to the computer or ready for printing. Full code of my sub is below. Hope this helps someone else avoid this headache!

Martin

Code: 
Sub Button95_Click()
 '-------------------------------------------
 'Product Search Results Print Button Clicked
 '-------------------------------------------
 Dim lastrow As Integer
 Dim oldprinter As String
 Dim temp As Variant
 Application.ScreenUpdating = False
 'Application.EnableEvents = False 'turn off events
 'unfreeze rows
 Sheet13.Activate
 ActiveWindow.FreezePanes = True
 
Sheet13.Unprotect
 Sheet13.Columns(3).NumberFormat = "###0.00"
 Sheet13.Protect
 'setup userform ready to ask user what columns to print
 UserForm13.printitemcodebox = True
 UserForm13.printdescriptionbox = True
 UserForm13.printitempricebox = True
 UserForm13.printtaxcodebox = False
 UserForm13.printdealcodebox = False
 UserForm13.printqtydeliveredbox = False
 UserForm13.printqtyinstockbox = True
 UserForm13.printqtysoldbox = False
 UserForm13.printdescription2box = True
 UserForm13.printdescription3box = True
 'ask user what columns to print
 UserForm13.Show
 'hide relevant columns before printing
 Sheet13.Unprotect
 Sheet13.Columns(1).EntireColumn.Hidden = Not UserForm13.printitemcodebox
 Sheet13.Columns(2).EntireColumn.Hidden = Not UserForm13.printdescriptionbox
 Sheet13.Columns(3).EntireColumn.Hidden = Not UserForm13.printitempricebox
 Sheet13.Columns(4).EntireColumn.Hidden = Not UserForm13.printtaxcodebox
 Sheet13.Columns(5).EntireColumn.Hidden = Not UserForm13.printdealcodebox
 Sheet13.Columns(6).EntireColumn.Hidden = Not UserForm13.printqtydeliveredbox
 Sheet13.Columns(7).EntireColumn.Hidden = Not UserForm13.printqtyinstockbox
 Sheet13.Columns(8).EntireColumn.Hidden = Not UserForm13.printqtysoldbox
 Sheet13.Columns(9).EntireColumn.Hidden = Not UserForm13.printdescription2box
 Sheet13.Columns(10).EntireColumn.Hidden = Not UserForm13.printdescription3box
 Sheet13.Protect
 Err.Clear
 On Error Resume Next
 oldprinter = Application.ActivePrinter
 DoEvents
 On Error GoTo 0
 If Err.Number <> 0 Then Call MsgBox("Print Error!", vbDefaultButton1 Or vbExclamation, ""): Exit Sub
 lastrow = Sheet13.Range("A" & LTrim(Str(maxrows))).End(xlUp).Row
 Application.ScreenUpdating = False
 With Worksheets("Product Search Results").PageSetup
         .FitToPagesWide = 1
         .Zoom = False
         .PrintArea = "A2:J" & LTrim(Str(lastrow))
         .LeftMargin = Application.InchesToPoints(0.5)
         .RightMargin = Application.InchesToPoints(0.5)
         .TopMargin = Application.InchesToPoints(0.5)
         .BottomMargin = Application.InchesToPoints(0.5)
         .PrintGridlines = True
         .BlackAndWhite = True
         .Orientation = xlPortrait
         .PrintHeadings = False
         .PrintComments = xlPrintNoComments
         .CenterHorizontally = True
         .CenterVertically = False
         .PrintErrors = xlPrintErrorsDisplayed
         .CenterHeader = "Product Search Results" & Chr(13) & "&p of &n  &T &D" 'header
 '        .CenterFooter = "" 'page numbers and time / date report printed in the footer
 End With
 Application.ScreenUpdating = True
 Err.Clear
 On Error Resume Next
 Application.Dialogs(xlDialogPrinterSetup).Show
 Range("A2:J" & LTrim(Str(lastrow))).PrintOut
 DoEvents
 On Error GoTo 0
 If Err.Number <> 0 Then Call MsgBox("Print Error!", vbDefaultButton1 Or vbExclamation, "")
 Application.ActivePrinter = oldprinter 'make sure if user changes printer we set back to default printer
 DoEvents
 Worksheets("Product Search Results").PageSetup.CenterHeader = "" 'clear page header
 Worksheets("Product Search Results").PageSetup.CenterFooter = "" 'clear page footer
 Call clearpagebreaks 'make sure we are not showing page breaks after printing
 Application.ScreenUpdating = False
 'make sure all columns are visible
 Sheet13.Unprotect
 Sheet13.Columns(1).EntireColumn.Hidden = False
 Sheet13.Columns(2).EntireColumn.Hidden = False
 Sheet13.Columns(3).EntireColumn.Hidden = False
 Sheet13.Columns(4).EntireColumn.Hidden = False
 Sheet13.Columns(5).EntireColumn.Hidden = False
 Sheet13.Columns(6).EntireColumn.Hidden = False
 Sheet13.Columns(7).EntireColumn.Hidden = False
 Sheet13.Columns(8).EntireColumn.Hidden = False
 Sheet13.Columns(9).EntireColumn.Hidden = False
 Sheet13.Columns(10).EntireColumn.Hidden = False
 Sheet13.Protect
 'freeze top two rows
 Sheet13.Rows(2).EntireRow.Select
 ActiveWindow.FreezePanes = True
 Sheet13.Range("A3").Select
 'Application.EnableEvents = True
 Application.ScreenUpdating = True
 End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
757
Aurum1
A
R
  • Question Question
Could I ask for VBA (or python) code to create a new workbooks?
Replies
2
Views
151
Radoslaw Poprawski
R
WERNER SLABBERT
  • Question Question
Run-time error 70 after code changed
Replies
3
Views
213
RoryA
RoryA
J
  • Solved
VBA/Macro: Adding Pivot table with connection string
Replies
1
Views
489
Jette3173
J
M
  • Solved
VBA- Inserting PageBreaks: Variable quantity, dynamic ranges
Replies
1
Views
586
menschmaschine
M

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