Re: VBA ActivePrinter
From: Jean-Yves (nomail_I_hate_spam_at_spam.com)
Date: 02/23/05
- Next message: Wayne: "Sendkeys debuging"
- Previous message: Greg: "Re: Event Schedules"
- In reply to: POM: "Re: VBA ActivePrinter"
- Messages sorted by: [ date ] [ thread ]
Date: Wed, 23 Feb 2005 11:08:50 +0100
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" <POM@discussions.microsoft.com> wrote in message
news:1F15A0CC-CB51-4FEA-AA3C-136B7B8F2487@microsoft.com...
> 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" <POM@discussions.microsoft.com> wrote in message
> > news:1BC197D2-6B0A-4E73-9ADF-C090FEA9177A@microsoft.com...
> > > 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!
> >
> >
> >
- Next message: Wayne: "Sendkeys debuging"
- Previous message: Greg: "Re: Event Schedules"
- In reply to: POM: "Re: VBA ActivePrinter"
- Messages sorted by: [ date ] [ thread ]
Relevant Pages
|
