PDA

View Full Version : Solved: Changing the printer designation for each user



Poundland
01-20-2009, 07:19 AM
Dear all,

I have recorded a Macro to create a PDF document from an Excel worksheet on the press of a button.

Code below;

Private Sub CommandButton7_Click()

Application.ActivePrinter = "PDFCreator on Ne00:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDFCreator on Ne00:, Collate:=True"
End
End Sub

My problem is that I want other users on their machines to be able to use this function and it will only work on my machine, the reason being is the designation Ne00 will only work on my machine on another machine I have tested it on the designation is Ne04, and another Ne07.

How can I customize this code so that it will print on anyones machine?

Thanks

nst1107
01-20-2009, 08:47 AM
Try creating a dictionary object using usernames as keys and printer extensions as items. Something like:Option Explicit
Dim PrintingDictionary
Sub BuildDictionary()
Set PrintingDictionary = CreateObject("scripting.dictionary")
PrintingDictionary.Add "Poundland", "Ne00"
PrintingDictionary.Add "Otherguy", "Ne01"
End SubRun this sub prior to printing. Then, use the .Item propery to recall the extension within your other sub. Something like:
Private Sub CommandButton7_Click()
On Error GoTo handler
Application.ActivePrinter = "PDFCreator on " & PrintingDictionary.Item(Application.UserName) & ":"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDFCreator on " _
& PrintingDictionary.Item(Application.UserName) & ":, Collate:=True"
End
handler:
Beep
MsgBox "Could not find printer. Username not recognized. Contact developer.", vbExclamation
End Sub

Poundland
01-20-2009, 09:17 AM
Try creating a dictionary object using usernames as keys and printer extensions as items. Something like:Option Explicit
Dim PrintingDictionary
Sub BuildDictionary()
Set PrintingDictionary = CreateObject("scripting.dictionary")
PrintingDictionary.Add "Poundland", "Ne00"
PrintingDictionary.Add "Otherguy", "Ne01"
End SubRun this sub prior to printing. Then, use the .Item propery to recall the extension within your other sub. Something like:
Private Sub CommandButton7_Click()
On Error GoTo handler
Application.ActivePrinter = "PDFCreator on " & PrintingDictionary.Item(Application.UserName) & ":"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDFCreator on " _
& PrintingDictionary.Item(Application.UserName) & ":, Collate:=True"
End
handler:
Beep
MsgBox "Could not find printer. Username not recognized. Contact developer.", vbExclamation
End Sub


I have tried this code it does not do what I want it to.

I have no idea how simple or complicated my request is, but I need some code that will either identify the port id on the users machine, capture that and then use this port to activate the PDFCreator and make this the active printer.

As per the code on my original post, which was recorded it will only work on my machine as every other user has a different port id.

nst1107
01-20-2009, 09:22 AM
I see. Has nothing to do with the user, just the computer. I have no idea how to help you with that. Perhaps someone else on here will have some ideas.

Poundland
01-20-2009, 10:20 AM
I see. Has nothing to do with the user, just the computer. I have no idea how to help you with that. Perhaps someone else on here will have some ideas.

I have resigned myself to the fact that I will have to have some form of user interaction, therefore have come up with the following code.

Private Sub CommandButton7_Click()
Dim default As String
default = ActivePrinter
MsgBox ("If your default printer is not set to create a PDF document you will be asked to select it - choose the PDF Printer and Press OK")
If Application.ActivePrinter Like "PDF*" Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
ActivePrinter:=Application.ActivePrinter Like "PDF*", Collate:=True
Else
'Choose printer
Application.Dialogs(xlDialogPrinterSetup).Show
ActiveWindow.SelectedSheets.PrintOut Copies:=1, _
ActivePrinter:=Application.ActivePrinter, Collate:=True
End If
Application.ActivePrinter = default
Debug.Print Application.ActivePrinter
End Sub

Thanks for all your help. :hi:

Kenneth Hobs
01-20-2009, 11:06 AM
For this solution, put the first two sections into Modules. The last would be the code for your commandbutton.

Notice in the code for your button, I used xld's method to set the printername rather than Application.ActivePrinter. You may be able to do that directly but it would fail if the user had no PDFCreator printername.

Module that I named mPrinterNames:
Option Explicit

'http://www.pcreview.co.uk/forums/thread-1645181.php
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const PRINTER_ENUM_CONNECTIONS = &H4

Private Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" _
(ByVal flags As Long, _
ByVal Name As String, _
ByVal Level As Long, _
pPrinterEnum As Any, _
ByVal cdBuf As Long, _
pcbNeeded As Long, _
pcReturned As Long) _
As Long

Private Declare Function StrLen Lib "kernel32" _
Alias "lstrlenA" _
(ByVal Ptr As Long) _
As Long

Private Declare Function StrCopy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal RetVal As String, _
ByVal Ptr As Long) _
As Long

Private Function CopyStringFromPtr(ByVal pSource As Long) As String
CopyStringFromPtr = Space$(StrLen(pSource))
StrCopy CopyStringFromPtr, pSource
End Function

Public Function GetPrinterNames() As Variant
Dim fSuccess As Boolean, lBuflen As Long, lFlags As Long
Dim aBuffer() As Long, lEntries As Long
Dim iCount As Integer, aPrinters() As String
lFlags = PRINTER_ENUM_LOCAL Or PRINTER_ENUM_CONNECTIONS
Call EnumPrinters(lFlags, vbNullString, 1, 0, 0, lBuflen, lEntries)
ReDim aBuffer(lBuflen \ 4)
fSuccess = EnumPrinters( _
lFlags, _
vbNullString, _
1, _
aBuffer(0), _
lBuflen, _
lBuflen, _
lEntries) <> 0
If fSuccess And lEntries > 0 Then
ReDim aPrinters(lEntries - 1)
For iCount = 0 To lEntries - 1
aPrinters(iCount) = CopyStringFromPtr(aBuffer(iCount * 4 + 2))
Next
GetPrinterNames = aPrinters
End If
End Function

In my Module mChangePrinter:
Option Explicit

'xld, http://www.vbaexpress.com/forum/showthread.php?t=24016
Private Type PRINTER_INFO_4
pPrinterName As Long
pServerName As Long
Attributes As Long
End Type

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
Private Const PRINTER_LEVEL4 = &H4
Private Const PRINTER_ENUM_LOCAL = &H2

Private Declare Function SendNotifyMessage Lib "user32" Alias "SendNotifyMessageA" ( _
ByVal hwnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" ( _
ByVal pszPrinter As String) As Long


Public Sub ChangePrinter(NewPrinter As String)

SetDefaultPrinter NewPrinter

'broadcast the change
Call SendNotifyMessage(HWND_BROADCAST, _
WM_WININICHANGE, _
0, ByVal "windows")
End Sub

Code to use for your button:
'Add Modules mChangePrinter and mPrinterNames:
Private Sub CommandButton7_Click()
Dim cPrinter As String, p, loc As Integer, prefix As String, s As String

prefix = "PDFCreator"
cPrinter = Application.ActivePrinter
'Debug.Print "ActivePrinter = " & cPrinter
p = GetPrinterNames

'On Error GoTo EndNow
loc = WorksheetFunction.Match(prefix, _
WorksheetFunction.Transpose(WorksheetFunction.Transpose(p)), -1) - 1
s = p(loc)

'Debug.Print Join(p, vbCrLf)
'Debug.Print loc, s

If LCase(Left(s, Len(prefix))) = LCase(prefix) Then
'Application.ActivePrinter = s 'Fails if Port not set.
ChangePrinter s
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'MsgBox "Found last, " & prefix & ", printer as: " & p(loc)
Else
GoTo EndNow
End If
Application.ActivePrinter = cPrinter

Exit Sub
EndNow:
MsgBox "Did not find a printer with a prefix name of " & prefix & "."
End Sub

Poundland
01-21-2009, 02:14 AM
Ken,

Thanks for that, but I think I will stay with my code, it is much shorter and it does the job albeit with a little interaction from the user, but hey make um work a little I say... :rotlaugh:

Thanks