Permet de modifier :
le format du papier
et/ou
l'orientation du papier
et/ou
le bac d'alimentation
Source / Exemple :
Public Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
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 * CCHFORMNAME
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' // Windows 9x seulement
dmICMIntent As Long ' // Windows 9x seulement
dmMediaType As Long ' // Windows 9x seulement
dmDitherType As Long ' // Windows 9x seulement
dmReserved1 As Long ' // Windows 9x seulement
dmReserved2 As Long ' // Windows 9x only
End Type
Public Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)
Private Const PRINTER_ATTRIBUTE_DEFAULT = 4
Private Const DM_MODIFY = 8
Private Const DM_IN_BUFFER = DM_MODIFY
Private Const DM_COPY = 2
Private Const DM_OUT_BUFFER = DM_COPY
Private Const DMDUP_SIMPLEX = 1
Private Const DMDUP_VERTICAL = 2
Private Const DMDUP_HORIZONTAL = 3
Private Const DM_DUPLEX = &H1000&
Private Const DM_DEFAULTSOURCE = &H200
Private Const DM_ORIENTATION = &H1&
Private Const DM_PAPERLENGTH = &H4&
Private Const DM_PAPERSIZE = &H2&
Private Const DM_PAPERWIDTH = &H8&
Private Const DM_YRESOLUTION = &H2000&
Public Const DMORIENT_PORTRAIT = &H1&
Public Const DMORIENT_LANDSCAPE = &H2&
Public Const DMPAPER_A4 = 9 ' A4 210 x 297 mm
Public Const DMPAPER_A5 = 11 ' A5 148 x 210 mm
Public Const DMPAPER_ENV_C5 = 28 ' Envelope C5 162 x 229 mm
Public Const DMPAPER_ENV_DL = 27 ' Envelope DL 110 x 220mm
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Declare Function GetLastError Lib "kernel32" () As Long
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long
Public Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Public Declare Function AbortDoc Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, ByVal fMode As Long) As Long
Public Function ChangePrinterSettings(ByRef pOldPaperSize As Long, ByRef pOldBin As Long, Optional ByVal pNewPaperSize, Optional ByVal pNewOrientation As Integer, Optional ByVal pNewBin As Integer) As Boolean
'****************************************************************
'* Gestion des imprimantes *
'*---------------------------------------------------------------------------- *
'* Modification : *
'* - du format du papier *
'* et/ou - de l'orientation *
'* et/ou - du bac d'entrée *
'****************************************************************
Dim hPrinter As Long 'Handle de printer
Dim pd As PRINTER_DEFAULTS
Dim ret As Long, i As Long
Dim TabInfos() As Long
Dim TabInfosSizeNeed As Long ' Taille du tableau nécessaire
Dim NewDevMode As DEVMODE
Dim pFullDevMode As Long
Dim LastError As Long
Dim rep As Long
On Error GoTo ChangePrinterSettingsError
'Affecte les membres de PRINTER_DEFAULTS
With pd
.pDatatype = 0&
.pDevMode = 0&
.DesiredAccess = PRINTER_ALL_ACCESS
End With
'Fournit un hPrinter à Printer.DeviceName
ret = OpenPrinter(Printer.DeviceName, hPrinter, pd)
'Echec de l'ouverture de l'imprimante
If ret = False Then
'pb de droits sur l'imprimante : on rééssaye avec des droits de simple utilisateur (Win NT/2000/XP seulement)
pd.DesiredAccess = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_USE)
ret = OpenPrinter(Printer.DeviceName, hPrinter, pd)
If ret = False Then
Select Case GetLastError()
Case 0 To 6
Case 1722
MsgBox "Votre imprimante par défaut est hors connexion. Si c'est une imprimante réseau, vérifier que le poste qui y est rattaché est bien allumé", vbExclamation
Exit Function
Case Else
MsgBox "Erreur de l'API OpenPrinter Code: " & GetLastError()
Exit Function
End Select
End If
End If
ret = GetPrinter(hPrinter, 2, ByVal 0&, 0, TabInfosSizeNeed)
' Pas de vérification de GetLastError ici (normalement -> échec avec une erreur 122 - ERROR_INSUFFICIENT_BUFFER)
' Redimensionnement de TabInfos selon les besoins
ReDim TabInfos((TabInfosSizeNeed \ 4))
' ... appel à GetPrinter() pour la récupération des infos
ret = GetPrinter(hPrinter, 2, TabInfos(0), TabInfosSizeNeed, TabInfosSizeNeed)
'Erreur de GetPrinter : erreurs 0, 6, 1722 ignorées (6 résultant d'un pb de droits utilisateur, 1722, d'une imprimante hors connexion)
If ret = False Then
Select Case GetLastError()
Case 0 To 6
Case 1722
MsgBox "Votre imprimante par défaut est hors connexion. Si c'est une imprimante réseau, vérifier que le poste qui y est rattaché est bien allumé", vbExclamation
Exit Function
Case Else
MsgBox "Erreur de l'API GetPrinter Code: " & GetLastError()
Exit Function
End Select
End If
'Extrait de la structure PRINTER_INFO2 la portion DEVMODE
pFullDevMode = TabInfos(7)
'Copie la portion pointée dans la sous-structure créée à cet effet
Call CopyMemory(NewDevMode, ByVal pFullDevMode, Len(NewDevMode))
'Changement du format du papier et/ou de l'orientation et/ou du bac
With NewDevMode
.dmFields = DM_ORIENTATION Or DM_DEFAULTSOURCE Or DM_PAPERSIZE
'Format papier
If Not IsMissing(pNewPaperSize) Then
If pNewPaperSize > 0 Then
pOldPaperSize = .dmPaperSize
.dmPaperSize = pNewPaperSize
End If
End If
'Orientation
If Not IsMissing(pNewOrientation) Then If pNewOrientation > 0 And pNewOrientation < 3 Then .dmOrientation = pNewOrientation
'Bac
If Not IsMissing(pNewBin) Then
If pNewBin > 0 And pNewBin < 5 Then
pOldBin = .dmDefaultSource
.dmDefaultSource = pNewBin
End If
End If
End With
'Mise à jour du pointeur
Call CopyMemory(ByVal pFullDevMode, NewDevMode, Len(NewDevMode))
'Mise à jour des infos dans la structure propre à l'imprimante
ret = DocumentProperties(0&, hPrinter, Printer.DeviceName, ByVal pFullDevMode, ByVal pFullDevMode, DM_IN_BUFFER Or DM_OUT_BUFFER)
'Mise à jour des propriétés (Windows) de l'imprimante
ret = SetPrinter(hPrinter, 2, TabInfos(0), 0&)
'Erreur de SetPrinter : erreurs 0, 6, 1722 ignorées (6 résultant d'un pb de droits utilisateur, 1722, d'une imprimante hors connexion)
If ret = False Then
Select Case GetLastError()
Case 0 To 6
Case 1722
MsgBox "Votre imprimante par défaut est hors connexion. Si c'est une imprimante réseau, vérifier que le poste qui y est rattaché est bien allumé", vbExclamation
Exit Function
Case Else
MsgBox "Erreur de l'API GetPrinter Code: " & GetLastError()
Exit Function
End Select
End If
'Fermeture du handle del'imprimante
ClosePrinter (hPrinter)
ChangePrinterSettings = True
Exit Function
ChangePrinterSettingsError:
Select Case Err.Number
Case 9, 484
'Err 9 : Débordement de tableau causé par un gestionnaire d'imprimante absent ou non accessible
'Err 484 : Pb d'accès au gestionnaire d'imprimante
Exit Function
Case Else
rep = MsgBox("Erreur : " & Err.Number & "(" & Err.Description & ")" & vbCrLf & "Continuez l'exécution de cette procédure ?", vbQuestion + vbYesNo, "APIs.BAS[ChangePrinterSettings]")
If rep = vbYes Then Resume Next Else Exit Function
End Select
End Function
Conclusion :
Peut générer une erreur sans gravité sous Windows >= NT; aucun pb rencontré dans les versions de Windows antérieures... Enfin, ne vous risquez pas sous 3.11 qd même ;-)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.