Discussion :

[HPJ]

Bonjour,

J'utilise l'objet Printer pour imprimer des étiquettes (rouleau de 9mm de large) mais je ne parviens pas à définir la longeur de l'étiquette...
Pour un texte qui fait 2 cm, l'imprimante sort une étiquette de plus 8 cm
J'ai essayé de changer la propriété Printer.Width, mais l'affectation n'a aucun effet:

Code :

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

1
2
3
4
    Printer.PaperSize = vbPRPSUser
    MsgBox Printer.Width ' -> 5040
    Printer.Width = 1000
    MsgBox Printer.Width ' -> 5040

Merci de vos remarques...

[bidou]

Code :

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

Printer.ScaleWidth

[HPJ]

Oui avec ScaleWidth l'affectation fonctionne mais la longueur de mon étiquette est toujours la même...
Les ScaleXXX ne correspondent pas à des tailles physiques, juste à une zone d'impression...

[HPJ]

Il faudrait définir la largeur d'un format de papier personnalisé comme dans l'onglet Taille de la mise en page de word...
Avec Word j'arrive à faire ce que je veux, ça doit bien être possible avec VB

[HPJ]

Après des heures de tests avec les fonctions DocumentProperties, ResetDC et SetPrinter, seule la dernière semble permettre de modifier le papier de l'imprimante et d'appliquer les modifications à Printer (Height et Width entre autres):

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
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