Method 'ActivePrinter' object_applicated failed

  • Thread starter Thread starter bhodge
  • Start date Start date
B

bhodge

Hello,

I have created a macro which uses the line:

Application.ActivePrinter = "Microsoft Office Document
Image Writer on Ne00:"

This helps speed up the macro. The problem I am running
into is I have 2 users who get the "Run Time Error 1004
Method 'ActivePrinter' object_applicated failed" message.
There is 4 users total including myself (creator of
macro). 1 other user can use the Macro, but the 2 who can
not, have just been given new computers (all of us are
running Excel 2003). Any idea why the 2 new users are
getting this error? Below is my entire macro. Thanks for
your help!


Sub Oneyear()
'
' Oneyear Macro
' Oneyear recorded 2/6/2004 by bhodge
'

'

Application.ActivePrinter = "Microsoft Office Document
Image Writer on Ne00:"
Dim AWB As Workbook
Set AWB = ActiveWorkbook
Application.ScreenUpdating = False
AWB.Activate
Workbooks.Open Filename:= _
"G:\Contract QuoteTemplates\Email Template
Macro.xls"
AWB.Activate
Windows("Email Template Macro.xls").Activate
Sheets("Features").Select
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Move After:=Sheets(3)
Sheets("Sheet1").Name = "Terms and Conditions"
AWB.Activate
Sheets("Terms and Conditions").Select
Cells.Select
Selection.Copy
Windows("Email Template Macro.xls").Activate
ActiveSheet.Paste
Range("A1").Select
AWB.Activate
Sheets("Quote Header").Select
Sheets("Quote Header").Copy Before:=Workbooks("Email
Template Macro.xls"). _
Sheets(1)
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
AWB.Activate
Sheets("Cover").Select
Sheets("Cover").Copy Before:=Workbooks("Email Template
Macro.xls").Sheets(2)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
AWB.Activate
Sheets("Agreement").Select
Sheets("Agreement").Copy Before:=Workbooks("Email
Template Macro.xls").Sheets _
(3)
Cells.Select
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Sheets("Cover").Select
Cells.Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Sheets("Quote Header").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range("D12").Select
Sheets("Cover").Select
Sheets("Cover").Name = "1YR Cover"
Sheets("Agreement").Select
Sheets("Agreement").Name = "1YR Agreement"
Range("F23").Select
Sheets("Quote Header").Select
Range("D4").Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 90
End With
Sheets("1YR Cover").Select
Range("B8").Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Zoom = 100
End With
Sheets("Terms and Conditions").Select
With ActiveSheet.PageSetup
.LeftFooter = _
"&6Psion Teklogix Maintenance Terms and Conditions
NA C.1 April 2003" & Chr(10) & "" & Chr(10) & "This
document and its content is Psion Teklogix proprietary and
shall not be reproduced or disclosed to any third party
without prior written consent."
.CenterFooter = ""
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.75)
.FooterMargin = Application.InchesToPoints(0.3)
.Orientation = xlLandscape
.Zoom = 100
End With
Sheets("1YR Agreement").Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = 70
Application.ScreenUpdating = True
End With
End Sub
 
Found the problem, the new users are set at Ne02 for the
Image writer. Now is there any way to where I can run this
code for both Ne00 and Ne02 users. Like a continue after
error message and throw the Ne02 line in. I don't want to
have to create to seperate macros in order to let the
users be able to use this. thanks.
 
From what I've read, sometimes the NE00 will change.

Can you verify if you all share the exact (character by character) printer name?

If it's slightly different, here's a post that cycles through the printers. You
may be able to pick out your printer based on a partial match.

http://google.com/[email protected]

You may want to consider just letting the user choose his own printer:

Application.Dialogs(xlDialogPrinterSetup).Show

And walk away a happy camper!
 
Back
Top