Private Declare Function EnumPrintersA Lib "Winspool.drv" (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long  
Private Declare Function lstrlenA Lib "Kernel32" (ByVal lpString As Any) As Long  
Private Declare Function lstrcpyA Lib "Kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long  
 
Private Function Imprimantes()  
  Dim PrinterEnum() As Long, Impr() As String  
  Dim Needed As Long, Returned As Long, i As Integer  
  EnumPrintersA 2, vbNullString, 5, 0, 0, Needed, 0  
  If Needed = 0 Then Exit Function  
  ReDim PrinterEnum(Needed / 4)  
  EnumPrintersA 2, vbNullString, 5, PrinterEnum(0), _  
  Needed, Needed, Returned  
  ReDim Impr(1 To Returned)  
  For i = 1 To Returned  
    Impr(i) = Space$(lstrlenA(PrinterEnum(i * 5 - 5)))  
    lstrcpyA Impr(i), PrinterEnum(i * 5 - 5)  
  Next i  
  Imprimantes = Impr  
End Function  
 
Sub ListeImprimante()  
 
Dim Impr  
Dim source as integer
For Each Impr In Imprimantes  
    source = source + Impr & ";" 'la liste des imprimante en contenue dans la liste.
    Liste_imprimante.RowSource = source
Next  
End Sub  

Private Declare Function aht_apiWriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (ByVal strAppName As String, ByVal strKeyName As String, ByVal strValue As String) As Integer
 
 
Private Sub Liste_imprimante_AfterUpdate()
 
ahtSetDefaultPrinter = (aht_apiWriteProfileString("Windows", "Device", Liste_imprimante.Value <> 0)
Call ListeImprimante
 
End Sub