VBA ActivePrinter
 

Hi all!

I need to send out a spreadsheet to users on different sites which has
several print macros included (making complicated selections). The document
has to be printed in colour - I set the macros up for my PC, using the path
to my colour printer. This will obviously be different for other users, and
the colour printer will not (generally) be their default printer. Before I
change the code completely, does anyone know a way of setting up an unknown
colour printer as your ActivePrinter?!

Cheers!

VBA ActivePrinter
 

hi,

You can read the registry lo get a list of all availbable printers and show
them in a list where the user can select the active printer before
printing.(via application.activeprinter= ...)

Regards
Jean-Yves


This function ("ListPrinter") works for NT4 and XP. You can load the
returned array in a listbox or combo.

Else you would have to modify the path to the correct registry folder.

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hKey _
As Long, ByVal dwIndex As Long, ByVal lpValueName As String,
lpcbValueName As Long, _
ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData
As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey _
As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal
samDesired _
As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, _
Source As Any, ByVal Length As Long)
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Function ListPrinter() As Variant
'Portions of this program written by Paul Kuliniewicz"
' http://www.vbapi.com
' modified by Tfelt Jean-Yves

Dim valuename As String ' name of the value being retrieved
Dim valuelen As Long ' length of valuename
Dim datatype As Long ' receives data type of value
Dim data(0 To 254) As Byte ' 255-byte data buffer for read
information
Dim datalen As Long ' size of data buffer information
Dim datastring As String ' will receive data converted to a
string, if necessary
Dim hKey As Long ' handle to the registry key to
enumerate the values of
Dim index As Long ' counter for the index of the value to
enumerate
Dim c As Long ' counter variable
Dim retval As Long ' functions' return value
Dim strPrinters As String
Dim arrPrinter() As String
Dim i As Byte
i = 0
' Open the registry key to enumerate the values of.
retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows
NT\CurrentVersion\Devices", _
0, KEY_QUERY_VALUE, hKey)
' Check to see if an error occured.
If retval < 0 Then
Debug.Print "Registry key could not be opened -- aborting."
End ' abort the program
End If

' Begin enumerating the values. Get each one, displaying its name.
If it's a null-
' terminated string or binary data, display it. If not, say so.
index = 0 ' initialize the counter
While retval = 0 ' loop while successful
' Initialize the value name buffer.
valuename = Space(255) ' 255-space buffer
valuelen = 255 ' length of the string
datalen = 255 ' size of data buffer
' Get the next value to be enumerated
retval = RegEnumValue(hKey, index, valuename, valuelen, 0,
datatype, data(0), datalen)
If retval = 0 Then ' if successful, display information
' Extract the useful information from the value name
buffer and display it.
valuename = Left(valuename, valuelen)
strPrinters = valuename '"Value Name: ";
' Determine the data type of the value and display
it.
Select Case datatype
Case REG_SZ ' null-terminated string
' Copy the information from the byte array
into the string.
' We subtract one because we don't want the
trailing null.
datastring = Space(datalen - 1) ' make just
enough room in the string
CopyMemory ByVal datastring, data(0),
datalen - 1 ' copy useful data
strPrinters = strPrinters & " on " &
Mid(datastring, 10) ' port name " Data (string): ";
Case REG_BINARY ' binary data
' Display the hexadecimal values of each
byte of data, separated by
' spaces. Use the datastring buffer to
allow us to assure each byte
' is represented by a two-character string.
Debug.Print " Data (binary):";
For c = 0 To datalen - 1 ' loop through
returned information
datastring = Hex(data(c)) ' convert
value into hex
' If needed, add leading zero(s).
If Len(datastring) < 2 Then
datastring = _
String(2 - Len(datastring),
"0") & datastring
Debug.Print " "; datastring;
Next c
Debug.Print ' end the line
Case Else ' a data type this example doesn't handle
Debug.Print "This example doesn't know how
to read that kind of data."
End Select
End If
index = index + 1 ' increment the index counter
ReDim Preserve arrPrinter(i)
arrPrinter(i) = strPrinters
i = i + 1
strPrinters = ""
Wend ' end the loop

' Close the registry key.
retval = RegCloseKey(hKey)
ListPrinter = arrPrinter
End Function

"POM" wrote in message
...
Hi all!

I need to send out a spreadsheet to users on different sites which has
several print macros included (making complicated selections). The
document
has to be printed in colour - I set the macros up for my PC, using the
path
to my colour printer. This will obviously be different for other users,
and
the colour printer will not (generally) be their default printer. Before
I
change the code completely, does anyone know a way of setting up an
unknown
colour printer as your ActivePrinter?!

Cheers!

VBA ActivePrinter
 

Thanks Jean-Yves - that should do the trick (when I work out where to put it!)

Thanks again.

"Jean-Yves" wrote:

hi,

You can read the registry lo get a list of all availbable printers and show
them in a list where the user can select the active printer before
printing.(via application.activeprinter= ...)

Regards
Jean-Yves


This function ("ListPrinter") works for NT4 and XP. You can load the
returned array in a listbox or combo.

Else you would have to modify the path to the correct registry folder.

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hKey _
As Long, ByVal dwIndex As Long, ByVal lpValueName As String,
lpcbValueName As Long, _
ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData
As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey _
As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal
samDesired _
As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long)
As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, _
Source As Any, ByVal Length As Long)
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Function ListPrinter() As Variant
'Portions of this program written by Paul Kuliniewicz"
' http://www.vbapi.com
' modified by Tfelt Jean-Yves

Dim valuename As String ' name of the value being retrieved
Dim valuelen As Long ' length of valuename
Dim datatype As Long ' receives data type of value
Dim data(0 To 254) As Byte ' 255-byte data buffer for read
information
Dim datalen As Long ' size of data buffer information
Dim datastring As String ' will receive data converted to a
string, if necessary
Dim hKey As Long ' handle to the registry key to
enumerate the values of
Dim index As Long ' counter for the index of the value to
enumerate
Dim c As Long ' counter variable
Dim retval As Long ' functions' return value
Dim strPrinters As String
Dim arrPrinter() As String
Dim i As Byte
i = 0
' Open the registry key to enumerate the values of.
retval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows
NT\CurrentVersion\Devices", _
0, KEY_QUERY_VALUE, hKey)
' Check to see if an error occured.
If retval < 0 Then
Debug.Print "Registry key could not be opened -- aborting."
End ' abort the program
End If

' Begin enumerating the values. Get each one, displaying its name.
If it's a null-
' terminated string or binary data, display it. If not, say so.
index = 0 ' initialize the counter
While retval = 0 ' loop while successful
' Initialize the value name buffer.
valuename = Space(255) ' 255-space buffer
valuelen = 255 ' length of the string
datalen = 255 ' size of data buffer
' Get the next value to be enumerated
retval = RegEnumValue(hKey, index, valuename, valuelen, 0,
datatype, data(0), datalen)
If retval = 0 Then ' if successful, display information
' Extract the useful information from the value name
buffer and display it.
valuename = Left(valuename, valuelen)
strPrinters = valuename '"Value Name: ";
' Determine the data type of the value and display
it.
Select Case datatype
Case REG_SZ ' null-terminated string
' Copy the information from the byte array
into the string.
' We subtract one because we don't want the
trailing null.
datastring = Space(datalen - 1) ' make just
enough room in the string
CopyMemory ByVal datastring, data(0),
datalen - 1 ' copy useful data
strPrinters = strPrinters & " on " &
Mid(datastring, 10) ' port name " Data (string): ";
Case REG_BINARY ' binary data
' Display the hexadecimal values of each
byte of data, separated by
' spaces. Use the datastring buffer to
allow us to assure each byte
' is represented by a two-character string.
Debug.Print " Data (binary):";
For c = 0 To datalen - 1 ' loop through
returned information
datastring = Hex(data(c)) ' convert
value into hex
' If needed, add leading zero(s).
If Len(datastring) < 2 Then
datastring = _
String(2 - Len(datastring),
"0") & datastring
Debug.Print " "; datastring;
Next c
Debug.Print ' end the line
Case Else ' a data type this example doesn't handle
Debug.Print "This example doesn't know how
to read that kind of data."
End Select
End If
index = index + 1 ' increment the index counter
ReDim Preserve arrPrinter(i)
arrPrinter(i) = strPrinters
i = i + 1
strPrinters = ""
Wend ' end the loop

' Close the registry key.
retval = RegCloseKey(hKey)
ListPrinter = arrPrinter
End Function

"POM" wrote in message
...
Hi all!

I need to send out a spreadsheet to users on different sites which has
several print macros included (making complicated selections). The
document
has to be printed in colour - I set the macros up for my PC, using the
path
to my colour printer. This will obviously be different for other users,
and
the colour printer will not (generally) be their default printer. Before
I
change the code completely, does anyone know a way of setting up an
unknown
colour printer as your ActivePrinter?!

Cheers!

VBA ActivePrinter
 

Hi,

Put all the code in a standard module. The function ListPrinter returns a
array of installed/available printers.

Use a form with a combobox. On form activate or intialise,
Dim lstPrinter as variant

Private Sub UserForm_Initialize()
Dim x As Integer
Dim strActPrint As String
strActPrint = Application.ActivePrinter
If Application.OperatingSystem = "Windows (32-bit) NT 4.00" Or _
Application.OperatingSystem = "Windows (32-bit) NT 5.01" Then
lstPrinter = ListPrinter
For x = 0 To UBound(lstPrinter) - 1
CombPrint.AddItem lstPrinter(x)
If lstPrinter(x) = strActPrint Then
CombPrint.ListIndex = x
End If
Next x
Else: CombPrint.AddItem Application.ActivePrinter
CombPrint.ListIndex = 0
End If
End sub
Regards
Jean-Yves

"POM" wrote in message
...
Thanks Jean-Yves - that should do the trick (when I work out where to put
it!)

Thanks again.

"Jean-Yves" wrote:

hi,

You can read the registry lo get a list of all availbable printers and
show
them in a list where the user can select the active printer before
printing.(via application.activeprinter= ...)

Regards
Jean-Yves


This function ("ListPrinter") works for NT4 and XP. You can load the
returned array in a listbox or combo.

Else you would have to modify the path to the correct registry folder.

Public Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hKey _
As Long, ByVal dwIndex As Long, ByVal lpValueName As String,
lpcbValueName As Long, _
ByVal lpReserved As Long, lpType As Long, lpData As Byte,
lpcbData
As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias
"RegOpenKeyExA" (ByVal hKey _
As Long, ByVal lpSubKey As String, ByVal ulOptions As Long,
ByVal
samDesired _
As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As
Long)
As Long
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory"
(Destination As Any, _
Source As Any, ByVal Length As Long)
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const KEY_QUERY_VALUE = &H1
Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const HKEY_CURRENT_USER = &H80000001
Public Function ListPrinter() As Variant
'Portions of this program written by Paul Kuliniewicz"
' http://www.vbapi.com
' modified by Tfelt Jean-Yves

Dim valuename As String ' name of the value being retrieved
Dim valuelen As Long ' length of valuename
Dim datatype As Long ' receives data type of value
Dim data(0 To 254) As Byte ' 255-byte data buffer for read
information
Dim datalen As Long ' size of data buffer information
Dim datastring As String ' will receive data converted to a
string, if necessary
Dim hKey As Long ' handle to the registry key to
enumerate the values of
Dim index As Long ' counter for the index of the value
to
enumerate
Dim c As Long ' counter variable
Dim retval As Long ' functions' return value
Dim strPrinters As String
Dim arrPrinter() As String
Dim i As Byte
i = 0
' Open the registry key to enumerate the values of.
retval = RegOpenKeyEx(HKEY_CURRENT_USER,
"Software\Microsoft\Windows
NT\CurrentVersion\Devices", _
0, KEY_QUERY_VALUE, hKey)
' Check to see if an error occured.
If retval < 0 Then
Debug.Print "Registry key could not be opened --
aborting."
End ' abort the program
End If

' Begin enumerating the values. Get each one, displaying its
name.
If it's a null-
' terminated string or binary data, display it. If not, say so.
index = 0 ' initialize the counter
While retval = 0 ' loop while successful
' Initialize the value name buffer.
valuename = Space(255) ' 255-space buffer
valuelen = 255 ' length of the string
datalen = 255 ' size of data buffer
' Get the next value to be enumerated
retval = RegEnumValue(hKey, index, valuename, valuelen,
0,
datatype, data(0), datalen)
If retval = 0 Then ' if successful, display information
' Extract the useful information from the value
name
buffer and display it.
valuename = Left(valuename, valuelen)
strPrinters = valuename '"Value Name: ";
' Determine the data type of the value and
display
it.
Select Case datatype
Case REG_SZ ' null-terminated string
' Copy the information from the byte
array
into the string.
' We subtract one because we don't want
the
trailing null.
datastring = Space(datalen - 1) ' make
just
enough room in the string
CopyMemory ByVal datastring, data(0),
datalen - 1 ' copy useful data
strPrinters = strPrinters & " on " &
Mid(datastring, 10) ' port name " Data (string): ";
Case REG_BINARY ' binary data
' Display the hexadecimal values of each
byte of data, separated by
' spaces. Use the datastring buffer to
allow us to assure each byte
' is represented by a two-character
string.
Debug.Print " Data (binary):";
For c = 0 To datalen - 1 ' loop through
returned information
datastring = Hex(data(c)) '
convert
value into hex
' If needed, add leading
zero(s).
If Len(datastring) < 2 Then
datastring = _
String(2 -
Len(datastring),
"0") & datastring
Debug.Print " "; datastring;
Next c
Debug.Print ' end the line
Case Else ' a data type this example doesn't
handle
Debug.Print "This example doesn't know
how
to read that kind of data."
End Select
End If
index = index + 1 ' increment the index counter
ReDim Preserve arrPrinter(i)
arrPrinter(i) = strPrinters
i = i + 1
strPrinters = ""
Wend ' end the loop

' Close the registry key.
retval = RegCloseKey(hKey)
ListPrinter = arrPrinter
End Function

"POM" wrote in message
...
Hi all!

I need to send out a spreadsheet to users on different sites which has
several print macros included (making complicated selections). The
document
has to be printed in colour - I set the macros up for my PC, using the
path
to my colour printer. This will obviously be different for other
users,
and
the colour printer will not (generally) be their default printer.
Before
I
change the code completely, does anyone know a way of setting up an
unknown
colour printer as your ActivePrinter?!

Cheers!