'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