#1
|
|||
|
|||
Get available Printers within a combobox
Dear all
VBA, unlike VB, does not provide a Printers Collection. But you may use the following code to get the available printers from the registry to a combobox. The code is valid for a maximal 10 available printers but may be adapted. Module 1 Code:
Sub Test() Dim SaveActivePrinter As String Dim ch5 As String Dim PrinterNames() As String SaveActivePrinter = ActivePrinter ReDim PrinterNames(0 To 9) Call GetPrinterNames(PrinterNames()) Call GetPrinterNameFromUser(PrinterNames(), ch5) ActivePrinter = ch5 ' Your Code ActivePrinter = SaveActivePrinter End Sub Code:
Private Const HKEY_CURRENT_USER As Long = &H80000001 Private Const HKCU = HKEY_CURRENT_USER Private Const KEY_QUERY_VALUE = &H1& Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _ Alias "RegOpenKeyExA" ( _ ByVal HKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) As Long Private Declare PtrSafe 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 Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _ ByVal HKey As Long) As Long Sub GetPrinterNameFromUser(ByRef PrinterNames As Variant, ByRef ch5 As String) Dim cBox As ComboBox Dim cBut As CommandButton Set cBox = UserForm1.ComboBox1 Set cBut = UserForm1.CommandButton1 cBut.Caption = "OK" cBut.Left = 100 cBox.Clear cBox.AddItem PrinterNames(0) cBox.AddItem PrinterNames(1) cBox.AddItem PrinterNames(2) cBox.AddItem PrinterNames(3) cBox.AddItem PrinterNames(4) cBox.AddItem PrinterNames(5) cBox.AddItem PrinterNames(6) cBox.AddItem PrinterNames(7) cBox.AddItem PrinterNames(8) cBox.AddItem PrinterNames(9) i = 0 Do While i <= 9 If (PrinterNames(i) = ActivePrinter) Then Exit Do End If i = i + 1 Loop cBox.ListIndex = i UserForm1.Caption = "Name of the printer?" UserForm1.Show ch5 = cBox.Value End Sub Sub GetPrinterNames(ByRef PrinterNames As Variant) Dim PNdx As Long ' index Dim HKey As Long ' registry key handle Dim Res As Long ' result of API calls Dim Ndx As Long ' index for RegEnumValue Dim ValueName As String ' name of each value in the printer key Dim ValueNameLen As Long ' length of ValueName Dim DataType As Long ' registry value data type Dim ValueValue() As Byte ' byte array of registry value value Dim M As Long ' string index Dim i As Integer 'registry key in HKCU listing printers Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices" PNdx = 0 Ndx = 0 ValueName = String$(256, Chr(0)) ' assume printer name is less than 256 characters ValueNameLen = 255 ReDim ValueValue(0 To 999) ' assume the port name is less than 1000 characters Res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _ KEY_QUERY_VALUE, HKey) Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _ 0&, DataType, ValueValue(0), 1000) i = 0 Do Until Res <> 0 M = InStr(1, ValueName, Chr(0)) If M > 1 Then ValueName = Left(ValueName, M - 1) PrinterNames(i) = ValueName i = i + 1 End If PNdx = PNdx + 1 ValueName = String(255, Chr(0)) ValueNameLen = 255 ReDim ValueValue(0 To 999) ' get the next registry value Ndx = Ndx + 1 ' get the next printer Res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _ 0&, DataType, ValueValue(0), 1000) Loop Res = RegCloseKey(HKey) End Sub Code:
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 Caption = "UserForm1" ClientHeight = 2685 ClientLeft = 120 ClientTop = 465 ClientWidth = 7065 OleObjectBlob = "UserForm1.frx":0000 StartUpPosition = 2 'CenterScreen End Attribute VB_Name = "UserForm1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub CommandButton1_Click() Unload Me End Sub Private Sub UserForm_Click() End Sub |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Lettherhead Header and Footer different Printers | Jacky_01 | Word | 2 | 08-20-2017 10:02 PM |
Page margins do not print on HP printers from Word | Prez | Word | 4 | 12-03-2015 02:08 AM |
What are the minimum margins most printers can handle? | 20GT | Word | 3 | 11-08-2014 10:40 PM |
"No printers are installed" error when copying cells | Dark Pumpkin | Excel | 5 | 06-14-2014 03:59 AM |
Word formatting and printers | d.macf | Word Tables | 2 | 04-18-2011 02:01 AM |