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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
| Option Explicit
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_PAPERLENGTH = &H4&
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const PRINTER_ACCESS_ADMINISTER = 4
Private Const PRINTER_ACCESS_USE = 8
Private Type PRINTER_INFO_2
pServerName As Long
pPrinterName As Long
pShareName As Long
pPortName As Long
pDriverName As Long
pComment As Long
pLocation As Long
pDevMode As Long
pSepFile As Long
pPrintProcessor As Long
pDatatype As Long
pParameters As Long
pSecurityDescriptor As Long
Attributes As Long
Priority As Long
DefaultPriority As Long
StartTime As Long
UntilTime As Long
Status As Long
cJobs As Long
AveragePPM As Long
End Type
Private Type DEVMODE
dmDeviceName(CCHDEVICENAME - 1) As Byte
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(CCHFORMNAME - 1) As Byte
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, ByVal pPrinter As Long, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, ByVal pPrinter As Long, ByVal Command 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" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Public Sub FixeTaillePapier(ByVal longueur As Long, ByVal largeur As Long)
Dim pdef As PRINTER_DEFAULTS
Dim ret As Long
Dim hPrinter As Long
Dim buffer() As Byte
Dim taille As Long
Dim pi2 As PRINTER_INFO_2
Dim mode As DEVMODE
Dim s As String
'accès pour lire et modifier la config
pdef.DesiredAccess = PRINTER_ACCESS_USE Or PRINTER_ACCESS_ADMINISTER
' ouvre l'imprimante
ret = OpenPrinter(Printer.DeviceName, hPrinter, VarPtr(pdef))
If ret = 0 Then
s = Space(255)
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, s, 255, ByVal 0)
Err.Raise vbObjectError + ret, "OpenPrinter", s
End If
' récupère la taille du bloc PRINTER_INFO_2
ret = GetPrinter(hPrinter, 2, 0, 0, taille)
If taille = 0 Then
s = Space(255)
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, s, 255, ByVal 0)
Err.Raise vbObjectError + ret, "GetPrinter", s
End If
' prépare le buffer
ReDim buffer(0 To taille - 1) As Byte
' récupère les infos de l'imprimante
ret = GetPrinter(hPrinter, 2, VarPtr(buffer(0)), taille, taille)
If ret = 0 Then
s = Space(255)
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, s, 255, ByVal 0)
Err.Raise vbObjectError + ret, "GetPrinter", s
End If
' copie le buffer dans la variable pi2
Call CopyMemory(VarPtr(pi2), VarPtr(buffer(0)), Len(pi2))
' copie la structure DEVMODE dans la variable mode
Call CopyMemory(VarPtr(mode), pi2.pDevMode, Len(mode))
' taille personnalisée
mode.dmPaperSize = 0
mode.dmPaperLength = longueur
mode.dmPaperWidth = largeur
' marque les champs qui on été modifiés
mode.dmFields = DM_PAPERLENGTH Or DM_PAPERWIDTH Or DM_PAPERSIZE
' copie la variable mode dans la structure DEVMODE
CopyMemory pi2.pDevMode, VarPtr(mode), Len(mode)
' fixe les nouveaux paramètres
ret = SetPrinter(hPrinter, 2, VarPtr(pi2), 0)
If ret = 0 Then
s = Space(255)
Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, Err.LastDllError, 0, s, 255, ByVal 0)
Err.Raise vbObjectError + ret, "SetPrinter", s
End If
End Sub |
