Excel

Changing printers in Excel

Ease of Use

Intermediate

Version tested with

2000, 2002, 2003 

Submitted by:

mdmackillop

Description:

Simple userform selection of printer. 

Discussion:

Where a document may be accessed from different vworkstations, not all computer/printer combinations have the same Ne?? value necessary for a coded button to work. While the code to retrieve the value is very complicated, its output is easily manipulated. (Apologies and grateful thanks to whoever wrote the main function) 

Code:

instructions for use

			

'The following code goes in a Userform, having two option buttons, one label 'and a command button. 'The OptionButtion captions must be set to the names of the printers to be selected. Option Explicit Option Compare Text Dim Printer As String Dim OldPrinter As String Private Sub UserForm_Initialize() OldPrinter = ActivePrinter OptionButton1.Caption = "PDF995" OptionButton2.Caption = "\\MyServer\HPColour" End Sub Private Sub OptionButton1_Click() Printer = GetPrinterKey(OptionButton1.Caption) Label1.Caption = Printer End Sub Private Sub OptionButton2_Click() Printer = GetPrinterKey(OptionButton2.Caption) Label1.Caption = Printer End Sub Private Sub CommandButton1_Click() If Printer = "" Or Printer = "Not Found" Then Exit Sub Application.ActivePrinter = Printer ActiveSheet.PrintOut Unload UserForm1 End Sub Private Sub UserForm_Terminate() ActivePrinter = OldPrinter End Sub 'The following code goes into a standard module. Option Explicit ' ----------------------------------------------------------------------------------------- Global Const REG_SZ As Long = 1 Global Const REG_DWORD As Long = 4 Global Const KEY_QUERY_VALUE = &H1 Global Const HKEY_CLASSES_ROOT = &H80000000 Global Const HKEY_CURRENT_USER = &H80000001 Global Const HKEY_LOCAL_MACHINE = &H80000002 Global Const HKEY_USERS = &H80000003 Global Const ERROR_NONE = 0 Global Const ERROR_BADDB = 1 Global Const ERROR_BADKEY = 2 Global Const ERROR_CANTOPEN = 3 Global Const ERROR_CANTREAD = 4 Global Const ERROR_CANTWRITE = 5 Global Const ERROR_OUTOFMEMORY = 6 Global Const ERROR_INVALID_PARAMETER = 7 Global Const ERROR_ACCESS_DENIED = 8 Global Const ERROR_INVALID_PARAMETERS = 87 Global Const ERROR_NO_MORE_ITEMS = 259 Global Const ERROR_SUCCESS = 0& Global Const ERROR_MORE_DATA = 234 Global Const KEY_ALL_ACCESS = &H3F Global Const REG_OPTION_NON_VOLATILE = 0 Declare Function RegCloseKey Lib "advapi32.dll" (ByVal lngHKey As Long) As Long Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal lngHKey As Long, _ ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, _ ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _ phkResult As Long, lpdwDisposition As Long) As Long Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal lngHKey As Long, _ ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, _ phkResult As Long) As Long Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, ByVal lpData As String, lpcbData As Long) As Long Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, lpData As Long, lpcbData As Long) As Long Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _ (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" _ (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _ ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _ (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _ ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" _ (ByVal lngHKey As Long, ByVal lpSubKey As String) Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" _ (ByVal lngHKey As Long, ByVal lpValueName As String) Public Function GetPrinterKey(Printer As String) Dim Lgth As Integer, PrinterKey As String PrinterKey = QueryValue(HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Printer) 'Get final characters of printer key and create full printername for active printer Lgth = Len(PrinterKey) On Error Goto ErrH GetPrinterKey = Printer & " on " & Mid(PrinterKey, Lgth - 5, 5) Exit Function ErrH: GetPrinterKey = "Not Found" End Function '2 Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, varValue As Variant) As Long Dim lngCCH As Long Dim lngRetCode As Long Dim lngType As Long Dim lngValue As Long Dim strValue As String On Error Goto QueryValueExError ' Determine the size and type of data to be read lngRetCode = RegQueryValueExNULL(lhKey, szValueName, 0&, lngType, 0&, lngCCH) If lngRetCode <> ERROR_NONE Then Error 5 Select Case lngType ' For strings Case REG_SZ: strValue = String(lngCCH, 0) lngRetCode = RegQueryValueExString(lhKey, szValueName, 0&, lngType, strValue, lngCCH) If lngRetCode = ERROR_NONE Then varValue = Left$(strValue, lngCCH) Else varValue = Empty End If ' For DWORDS Case REG_DWORD: lngRetCode = RegQueryValueExLong(lhKey, szValueName, 0&, lngType, lngValue, lngCCH) If lngRetCode = ERROR_NONE Then varValue = lngValue Case Else 'all other data types not supported lngRetCode = -1 End Select QueryValueExExit: QueryValueEx = lngRetCode Exit Function QueryValueExError: Resume QueryValueExExit End Function '5 Public Function QueryValue(lngKey As Long, strKeyName As String, strvaluename As String) As Variant ' Description: ' Return the data field of a value ' ' Syntax: ' Variable = QueryValue(KeyLocation, KeyName, ValueName) ' ' KeyLocation must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE, HKEY_USERS ' ' KeyName is the key that the value is under ' (example: "Software\Microsoft\Windows\CurrentVersion\Explorer") ' ' ValueName is the name of the value you want to access (example: "link") Dim lngRetVal As Long 'result of the API functions Dim lngHKey As Long 'handle of opened key Dim varValue As Variant 'setting of queried value lngRetVal = RegOpenKeyEx(lngKey, strKeyName, 0, KEY_ALL_ACCESS, lngHKey) lngRetVal = QueryValueEx(lngHKey, strvaluename, varValue) QueryValue = varValue RegCloseKey (lngHKey) End Function Public Sub ShowForm() UserForm1.Show False End Sub

How to use:

  1. Open an Excel workbook
  2. Select Tools/Macro/Visual Basic Editor
  3. In the VBE window, select Insert/UserForm
  4. Select the toolbox, add 2 OptionButtons, a Label and a CommandButton on the UserForm
  5. Right-Click UserForm1 in the Project - VBA Project pane
  6. Select ShowCode
  7. Select everything, then copy and paste the userform code into the code window
  8. Set the OptionButton values to printer names on your system
  9. Now select Insert/Module, paste the code for the standard module into this module
  10. Click the X in the top right of the VBE window to return to Excel
  11. Save your work...
 

Test the code:

  1. In the attached sample, change the OptionButton captions to printers on your computer.
  2. Save the changes
  3. On sheet1, click the Select Printer button
 

Sample File:

Printing.zip 19.31KB 

Approved by mdmackillop


This entry has been viewed 285 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2014 VBA Express