You are here List printer to ComboBox have image, icon - BSAC Controls

List printer to ComboBox have image, icon - BSAC Controls

ComboBox list printer and image - BSAC controls

 

In VBA, do with step by step:

Step 1: Create Userform

Make sure you have installed Add-in A-Tools or BSAC.ocx activex controls before do Step 2

Step 2: Click to userform, see window "Toolbox", right click on tab "Controls" -> "Import Page", select file "ImportToToolbox.pag" (Download)

(Do Step 2 only if you do not see BSAC controls on Toolbox window)

Step 3: Drag controls to userform: BSComboBox, BSListNox, BSButton, BSImageList,  Label (name Label2)

Step 4: Right click on userform -> View Code. Now you have widow to edit code. Copy below code:
'-------BEGIN COPY
'VBA programming with BSAC - Bluesofts ActiveX Controls
Option Explicit
'Author: Nguyen Duy Tuan - http://bluesofts.net - http://atoolspro.com
#If VBA7 Then
Private Declare PtrSafe Function DestroyIcon Lib "User32.dll" (ByVal HIcon As LongPtr) As Long
#Else
Private Declare Function DestroyIcon Lib "User32.dll" (ByVal HIcon As Long) As Long
#End If
 
Private Sub UserForm_Initialize()
    Dim HIcon As Long, I&, n As Long
    'Setup ImageList for display icon in Combobox
    BSImageList1.ListImages.Clear
    BSImageList1.PicHeight = 32
    BSImageList1.PicWidth = 32
    BSImageList1.UseImageListDraw = True 'BSAC v2.0.0.6 - 05-04-2019
    For I = 105 To 108 'get icons from "shell32.dll" and put them to BSImageList
        HIcon = ExtractIcon(Application.HinstancePtr, GetSysDir & "\shell32.dll", I)
        BSImageList1.ListImages.AddIcon HIcon
        DestroyIcon HIcon
    Next I
    'Link BSImageList to BSCombobox
    Set BSComboBox1.ImageList = BSImageList1
    'Setup BSCombobox display image in item
    BSComboBox1.Style = csExpertAutoBuild
    BSComboBox1.ItemHeight = 32
    CollectPrinters
End Sub
 
Sub CollectPrinters()
    Dim sComputer As String, I&
    Dim objWMIService As Object, objListPrinters As Object, objPrinter As Object
 
    sComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
                                  & "{impersonationLevel=impersonate}!\\" & sComputer & "\root\cimv2")
 
    Set objListPrinters = objWMIService.ExecQuery _
                               ("Select * from Win32_Printer")
    BSComboBox1.Clear
    For Each objPrinter In objListPrinters
        BSComboBox1.Items.Add objPrinter.Name, GetImageIdx(objPrinter)
    Next
End Sub
 
Private Sub UserForm_Terminate()
    BSImageList1.ListImages.Clear
End Sub
 
Function GetImageIdx(Prt As Object) As Long
    Dim IsDefault As Boolean
    IsDefault = Prt.Default
    If Prt.Network Then
        If IsDefault Then
            GetImageIdx = 2
        Else
            GetImageIdx = 3
        End If
    Else
        If IsDefault Then
            GetImageIdx = 1
        Else
            GetImageIdx = 0
        End If
    End If
End Function
 
Private Sub BSButton1_OnClick()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    sh.PrintOut , , , , BSComboBox1.Selected.Text
End Sub
 
Private Sub BSComboBox1_OnSelect()
    Label2.Caption = BSComboBox1.Selected.Text
    Label2.Enabled = True
End Sub
'-------END COPY

Support online: https://www.facebook.com/groups/hocexcel/