gestion des imprimantes sous VBA excel

[David]

Bonjour

Je ne trouve pas la fonction sous VBA excel qui me donnerais le nbre d'imprimante disponnible et leurs noms.

Merci par avance.

David

 

[chris]

Bonsoir David,

Essayes ça....

Option Explicit

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 Sub RtlMoveMemory Lib 'Kernel32' (pDest As Long, _
ByVal pSource As Long, ByVal Length 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

Sub Test()
Dim PrinterEnum() As Long, Impr As String
Dim Needed As Long, Returned As Long, I As Integer
Dim Res As Long
EnumPrintersA 2, vbNullString, 2, 0, 0, Needed, 0
If Needed = 0 Then MsgBox 'Erreur', vbCritical: Exit Sub
ReDim PrinterEnum(Needed / 4)
If EnumPrintersA(2, vbNullString, 2, PrinterEnum(0), Needed, _
Needed, Returned) = 0 Then MsgBox 'Erreur', vbCritical: Exit Sub
For I = 1 To Returned * 21 Step 21
Impr = Space$(lstrlenA(PrinterEnum(I)))
lstrcpyA Impr, PrinterEnum(I)
If PrinterEnum(I + 6) Then _
RtlMoveMemory Res, PrinterEnum(I + 6) + 58, 2
MsgBox 'Imprimante : ' & Impr & vbCr & vbCr & 'Résolution : ' _
& IIf(PrinterEnum(I + 6), Res, 'Inconnue')
Next I
End Sub

 

[MichelXld]

bonsoir David , bonsoir Chris

ci joint une autre possibilité , si tu utilises Windows XP

Sub proprietesImprimantes()
Dim objWMIService As Object, colItems As Object
Dim objItem As Object
Dim strComputer As String
Dim i As Byte

On Error Resume Next
strComputer = '.'
Set objWMIService = GetObject('winmgmts:\\\\' & strComputer & '\\root\\cimv2')
Set colItems = objWMIService.ExecQuery('Select * from Win32_PrinterConfiguration', , 48)

For Each objItem In colItems
i = i + 1
Cells(1, i) = 'BitsPerPel: ' & objItem.BitsPerPel
Cells(2, i) = 'Caption: ' & objItem.Caption
Cells(3, i) = 'Collate: ' & objItem.Collate
Cells(4, i) = 'Color: ' & objItem.Color
Cells(5, i) = 'Copies: ' & objItem.Copies
Cells(6, i) = 'Description: ' & objItem.Description
Cells(7, i) = 'DeviceName: ' & objItem.DeviceName
Cells(8, i) = 'DisplayFlags: ' & objItem.DisplayFlags
Cells(9, i) = 'DisplayFrequency: ' & objItem.DisplayFrequency
Cells(10, i) = 'DitherType: ' & objItem.DitherType
Cells(11, i) = 'DriverVersion: ' & objItem.DriverVersion
Cells(12, i) = 'Duplex: ' & objItem.Duplex
Cells(13, i) = 'FormName: ' & objItem.FormName
Cells(14, i) = 'HorizontalResolution: ' & objItem.HorizontalResolution
Cells(15, i) = 'ICMIntent: ' & objItem.ICMIntent
Cells(16, i) = 'ICMMethod: ' & objItem.ICMMethod
Cells(17, i) = 'LogPixels: ' & objItem.LogPixels
Cells(18, i) = 'MediaType: ' & objItem.MediaType
Cells(19, i) = 'Name: ' & objItem.Name
Cells(20, i) = 'Orientation: ' & objItem.Orientation
Cells(21, i) = 'PaperLength: ' & objItem.PaperLength
Cells(22, i) = 'PaperSize: ' & objItem.PaperSize
Cells(23, i) = 'PaperWidth: ' & objItem.PaperWidth
Cells(24, i) = 'PelsHeight: ' & objItem.PelsHeight
Cells(25, i) = 'PelsWidth: ' & objItem.PelsWidth
Cells(26, i) = 'PrintQuality: ' & objItem.PrintQuality
Cells(27, i) = 'Scale: ' & objItem.Scale
Cells(28, i) = 'SettingID: ' & objItem.SettingID
Cells(29, i) = 'SpecificationVersion: ' & objItem.SpecificationVersion
Cells(30, i) = 'TTOption: ' & objItem.TTOption
Cells(31, i) = 'VerticalResolution: ' & objItem.VerticalResolution
Cells(32, i) = 'XResolution: ' & objItem.XResolution
Cells(33, i) = 'YResolution: ' & objItem.YResolution

Columns(i).AutoFit
Next

End Sub

bonne soiree
MichelXld