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
| Option Explicit
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Public Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" _
(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
Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long
Public Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
(ByVal Ptr As Long) As Long
Public Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim StrPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print "iBuffer too small. Trying again with "; iBufferSize & " bytes."
ReDim iBuffer(iBufferSize \ 4) As Long
End If
'Try again with new buffer
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, _
1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True, use found printers to fill the array
ReDim StrPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
StrPrinters(iIndex) = strPrinterName
Next iIndex
End If
ListPrinters = StrPrinters
End Function
Public Function IsBounded(vArray As Variant) As Boolean
'If the variant passed to this function is an array, the function will return True;
'otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))
End Function
Public sub Test()
Dim StrPrinters As Variant, i As Long
Dim bResult As Boolean
Global_ImprimantePDF = "NO_PRINTERS"
'Recherche des imprimantes présentes sur le poste utilisateur
StrPrinters = ListPrinters
'Vérifie s'il y a plusieurs imprimantes (tableau)
If IsBounded(StrPrinters) Then
For i = LBound(StrPrinters) To UBound(StrPrinters)
'Debug.Print StrPrinters(i)
If InStr(LCase(StrPrinters(i)), LCase("PDF")) > 0 Then
'On prend la première imprimante PDF disponible
Global_ImprimantePDF = StrPrinters(i)
Exit For
End If
Next i
'Recherche l'imprimante active
Global_ImprimanteActive = Application.ActivePrinter
bResult = False
For i = LBound(StrPrinters) To UBound(StrPrinters)
If InStr(LCase(Global_ImprimanteActive), LCase(StrPrinters(i))) > 0 Then
'On prend la valeur correcte
Global_ImprimanteActive = StrPrinters(i)
bResult = True
Exit For
End If
Next i
If bResult = False Then
Global_ImprimanteActive = "NO_PRINTERS"
MsgBox ("Impossible de trouver l'imprimante active !")
End If
Else
Debug.Print "No printers found"
Global_ImprimanteActive = "NO_PRINTERS"
End If
end sub |
Word -> PDF
Répondre avec citation
: 
Partager