Discussion :

[allergique]

Bonjour,

Est-ce possible, à partir d'une liste d'imprimantes de voir si l'imprimante est de type virtuelle (pdfcreator, office document image writer etc...) ou si l'mprimante est une imprimante physique (réseau, locale etc...)?

merci et bonne soirée

[jfontaine]

Bonjour,

Peut être en filtrant le type de port utilisé par l'imprimante

[kiki29]

Salut, 2 codes pêchés je sais plus ou sur le net, peut-être même sur ce site, milles excuses pour leurs auteurs,enfin bref ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
 
Option Explicit
 
Sub Lister_Proprietes_Imprimantes()
Dim objWMIService As Object, colInstalledPrinters As Object
Dim objPrinter As Object
Dim nomPC As String, r As Long, c As Long
 
    ShPrinter.Cells.Clear
    nomPC = "."
 
    Set objWMIService = GetObject("winmgmts:" & _
                                  "{impersonationLevel=impersonate}!\\" & nomPC & "\root\cimv2")
    Set colInstalledPrinters = objWMIService. _
                               ExecQuery("Select * from Win32_Printer")
 
    r = 2: c = 1
    With ShPrinter
        .Cells(r, c) = "Attributes"
        .Cells(r + 1, c) = "Availability"
        .Cells(r + 2, c) = "AveragePagesPerMinute"
        .Cells(r + 3, c) = "Caption"
        .Cells(r + 4, c) = "ConfigManagerErrorCode"
        .Cells(r + 5, c) = "ConfigManagerUserConfig"
        .Cells(r + 6, c) = "CreationClassName"
        .Cells(r + 7, c) = "DefaultPriority"
        .Cells(r + 8, c) = "Description"
        .Cells(r + 9, c) = "DetectedErrorState"
        .Cells(r + 10, c) = "DeviceID"
        .Cells(r + 11, c) = "DriverName"
        .Cells(r + 12, c) = "ErrorCleared"
        .Cells(r + 13, c) = "ErrorDescription"
        .Cells(r + 14, c) = "HorizontalResolution"
        .Cells(r + 15, c) = "InstallDate"
        .Cells(r + 16, c) = "JobCountSinceLastReset"
        .Cells(r + 17, c) = "LanguagesSupported"
        .Cells(r + 18, c) = "LastErrorCode"
        .Cells(r + 19, c) = "Location"
        .Cells(r + 20, c) = "Name"
        .Cells(r + 21, c) = "PNPDeviceID"
        .Cells(r + 22, c) = "PortName"
        .Cells(r + 23, c) = "PowerManagementCapabilities"
        .Cells(r + 24, c) = "PowerManagementSupported"
        .Cells(r + 25, c) = "PrinterState"
        .Cells(r + 26, c) = "PrinterStatus"
        .Cells(r + 27, c) = "PrintJobDataType"
        .Cells(r + 28, c) = "PrintProcessor"
        .Cells(r + 29, c) = "SeparatorFile"
        .Cells(r + 30, c) = "ServerName"
        .Cells(r + 31, c) = "ShareName"
        .Cells(r + 32, c) = "SpoolEnabled"
        .Cells(r + 33, c) = "StartTime"
        .Cells(r + 34, c) = "Status"
        .Cells(r + 35, c) = "StatusInfo"
        .Cells(r + 36, c) = "SystemCreationClassName"
        .Cells(r + 37, c) = "SystemName"
        .Cells(r + 38, c) = "TimeOfLastReset"
        .Cells(r + 39, c) = "UntilTime"
        .Cells(r + 40, c) = "VerticalResolution"
        .Cells(r + 41, c) = "PaperSizesSupported"
        .Cells(r + 42, c) = "PrinterPaperNames"
 
'        .Cells(r + 43, c) = "Capabilities"
'        .Cells(r + 44, c) = "CapabilityDescriptions"
    End With
 
    c = c + 1
    For Each objPrinter In colInstalledPrinters
        With ShPrinter
            .Cells(r, c) = objPrinter.Attributes
            .Cells(r + 1, c) = objPrinter.Availability
            .Cells(r + 2, c) = objPrinter.AveragePagesPerMinute
            .Cells(r + 3, c) = objPrinter.Caption
            .Cells(r + 4, c) = objPrinter.ConfigManagerErrorCode
            .Cells(r + 5, c) = objPrinter.ConfigManagerUserConfig
            .Cells(r + 6, c) = objPrinter.CreationClassName
            .Cells(r + 7, c) = objPrinter.DefaultPriority
            .Cells(r + 8, c) = objPrinter.Description
            .Cells(r + 9, c) = objPrinter.DetectedErrorState
            .Cells(r + 10, c) = objPrinter.DeviceID
            .Cells(r + 11, c) = objPrinter.DriverName
            .Cells(r + 12, c) = objPrinter.ErrorCleared
            .Cells(r + 13, c) = objPrinter.ErrorDescription
            .Cells(r + 14, c) = objPrinter.HorizontalResolution
            .Cells(r + 15, c) = objPrinter.InstallDate
            .Cells(r + 16, c) = objPrinter.JobCountSinceLastReset
            .Cells(r + 17, c) = objPrinter.LanguagesSupported
            .Cells(r + 18, c) = objPrinter.LastErrorCode
            .Cells(r + 19, c) = objPrinter.Location
            .Cells(r + 20, c) = objPrinter.Name
            .Cells(r + 21, c) = objPrinter.PNPDeviceID
            .Cells(r + 22, c) = objPrinter.PortName
            .Cells(r + 23, c) = objPrinter.PowerManagementCapabilities
            .Cells(r + 24, c) = objPrinter.PowerManagementSupported
            .Cells(r + 25, c) = objPrinter.PrinterState
            .Cells(r + 26, c) = objPrinter.PrinterStatus
            .Cells(r + 27, c) = objPrinter.PrintJobDataType
            .Cells(r + 28, c) = objPrinter.PrintProcessor
            .Cells(r + 29, c) = objPrinter.SeparatorFile
            .Cells(r + 30, c) = objPrinter.ServerName
            .Cells(r + 31, c) = objPrinter.ShareName
            .Cells(r + 32, c) = objPrinter.SpoolEnabled
            .Cells(r + 33, c) = objPrinter.StartTime
            .Cells(r + 34, c) = objPrinter.Status
            .Cells(r + 35, c) = objPrinter.StatusInfo
            .Cells(r + 36, c) = objPrinter.SystemCreationClassName
            .Cells(r + 37, c) = objPrinter.SystemName
            .Cells(r + 38, c) = objPrinter.TimeOfLastReset
            .Cells(r + 39, c) = objPrinter.UntilTime
            .Cells(r + 40, c) = objPrinter.VerticalResolution
 
            .Cells(r + 41, c) = objPrinter.PaperSizesSupported
            .Cells(r + 42, c) = objPrinter.PrinterPaperNames
'            .Cells(r + 43, c) = objPrinter.Capabilities
'            .Cells(r + 44, c) = objPrinter.CapabilityDescriptions
        End With
        c = c + 1
    Next objPrinter
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
 
Option Explicit
 
Sub TstNetworkPrinter()
    Debug.Print NetworkPrinter("PDFCreator")
    Debug.Print NetworkPrinter("Adobe PDF")
    Debug.Print NetworkPrinter("Microsoft XPS Document Writer")
    Debug.Print NetworkPrinter("EPSON EPL-5900L Advanced")
End Sub
 
Private Function NetworkPrinter(ByVal myprinter As String)
Dim NetWork As Variant
Dim x As Integer
 
    On Error Resume Next
    ' Tableau Imprimantes
    NetWork = Array("Ne00:", "Ne01:", "Ne02:", "Ne03:", "Ne04:", _
                    "Ne05:", "Ne06:", "Ne07:", "Ne08:", _
                    "Ne09:", "Ne10:", "Ne11:", "Ne12:", _
                    "Ne13:", "Ne14:", "Ne15:", "Ne16:", _
                    "LPT1:", "LPT2:", "File:")
    'Setup printer to Print
    x = 0
Retry:
    On Error Resume Next
    'Imprimante
    Application.ActivePrinter = myprinter & " sur " & NetWork(x)
    If Err.Number <> 0 And x < 16 Then
        x = x + 1
        GoTo Retry
    ElseIf Err.Number <> 0 And x > 15 Then
        GoTo PrtError
    End If
    On Error GoTo 0
    NetworkPrinter = myprinter & " sur " & NetWork(x)
errorExit:
    Exit Function
PrtError:
    'Pas d'imprimante
    NetworkPrinter = ""
    Resume errorExit
End Function

[ucfoutu]

Bonsoir,

Oui (salut, jfontaine)

et cela peut se faire par utilisatioin des fonctions OpenPrinter et GetPrinter de la librairie Winspoll.drv de l'Apî de Windows, en passant comme paramètre (à OpenPrinter) le nom de l'imprimante.

[allergique]

Bonsoir,

Merci à tous pour votre aide...

Je vais regarder vos différentes solutions à chacun. Pour les api j'avais beaucoup de mal à les faire fonctionner, mais peut-être qu'entre temps je me suis un peu amélioré

bonne soirée

[ucfoutu]

Pour les api j'avais beaucoup de mal à les faire fonctionner, mais peut-être qu'entre temps je me suis un peu amélioré

Je t'en félicite...

Mais pour t'y aider, essaye ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Private Type DEVMODE
    dmDeviceName As String * 32
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * 32
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Type PRINTER_DEFAULTS
  pDatatype As String
  pDevMode As DEVMODE
  DesiredAccess As Long
End Type
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function IsBadStringPtrByLong Lib "kernel32" Alias "IsBadStringPtrA" (ByVal lpsz As Long, ByVal ucchMax As Long) As Long
Public Function StringFromPointer(lpString As Long, lMaxLength As Long) As String
    Dim sRet As String
    Dim lret As Long
    If lpString = 0 Then
        StringFromPointer = ""
        Exit Function
    End If
    If IsBadStringPtrByLong(lpString, lMaxLength) Then
        StringFromPointer = ""
        Exit Function
    End If
    sRet = Space$(lMaxLength)
    CopyMemory ByVal sRet, ByVal lpString, ByVal Len(sRet)
    If Err.LastDllError = 0 Then
        If InStr(sRet, Chr$(0)) > 0 Then
            sRet = Left$(sRet, InStr(sRet, Chr$(0)) - 1)
        End If
    End If
    StringFromPointer = sRet
End Function



Private Sub CommandButton1_Click()
    Dim SizeNeeded As Long, buffer() As Long
    Dim pDef As PRINTER_DEFAULTS
'  bien sur, mets le nom complet de TON imprimante la-dessous
    lret = OpenPrinter("Canon Bubble-Jet BJC-3000", mhPrinter, pDef)
    ReDim Preserve buffer(0 To 0) As Long
    lret = GetPrinter(mhPrinter, 2, buffer(0), UBound(buffer), SizeNeeded)
    ReDim Preserve buffer(0 To (SizeNeeded / 4) + 3) As Long
    lret = GetPrinter(mhPrinter, 2, buffer(0), UBound(buffer) * 4, SizeNeeded)
    ClosePrinter mhPrinter
    Dim leport As String
    leport = StringFromPointer(buffer(3), 255)
    If LenB(leport) > 0 Then
        MsgBox "port : " + leport
        Dim reel As String
        reel = UCase(Left(leport, 3))
        If reel = "USB" Or reel = "LPT" Or reel = "COM" Then
          MsgBox "réelle"
        Else
          MsgBox "Virtuelle"
        End If
     End If
End Sub

[allergique]

Bonsoir tout le monde,

Vos codes fonctionnent bien, mais malheureusement pas complètement pour mon application...

Mes imprimantes réseau sont détectées comme imprimantes virtuelles parce que le port n'est pas de type LPT, COM ou USB...
Le port retourné est composé de chiffres et de lettres. N'y a-t-il aucun moyen de faire cette distinction?


J'aurais une autre question, à propos de la fonction "PaperSizesSupported"

En fonction des imprimantes, le nombre de formats de papier peut aller de 7 à 21. Comment est-ce possible de lister les formats de papier disponibles à partir de cette fonction?

Merci et bonne soirée