Changer les propriétés de l'imprimante en cours

Commenter

Contenu du snippet

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

A voir également

S'inscrire maintenant

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.

Du même auteur (Matesys)