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