IMPRIMER SUR L'IMPRIMANTE DE SON CHOIX SANS MODIFIER L'IMPRIMANTE PAR DÉFAUT

Option Explicit

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const PD_RETURNDC = &H100
Private Const PD_RETURNIC = &H200
Private Const NULL_PTR = 0&

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
        dmUnusedPadding As Integer
        dmBitsPerPel As Long
        dmPelsWidth As Long
        dmPelsHeight As Long
        dmDisplayFlags As Long
        dmDisplayFrequency As Long
End Type
Private Type DEVNAMES
        wDriverOffset As Integer
        wDeviceOffset As Integer
        wOutputOffset As Integer
        wDefault As Integer
End Type
'renommé pour différencier avec la fonction PrintDlg
Private Type InformationImprimante      ' PRINTDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hdc As Long
    flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type

Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As InformationImprimante) As Long

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Private Sub cmdImprimer_Click()
    Dim retourAPI As Long
    Dim imprimanteSelectionne As InformationImprimante
    Dim infoDevice As DEVMODE
    Dim nomImprimante As String
    Dim adresseStructureDEVMODE As Long
    Dim imprimante As Printer
    '
    On Error GoTo Err_Impression
    '
    retourAPI = 0
    '
    ' Initialisation de la structure d'échange
    '
    imprimanteSelectionne.lStructSize = Len(imprimanteSelectionne)
    imprimanteSelectionne.hDevMode = NULL_PTR
    imprimanteSelectionne.hDevNames = NULL_PTR
    imprimanteSelectionne.flags = PD_RETURNIC

    ' Ouverture du CommonDialog via l'API PrintDlg
    retourAPI = PrintDlg(imprimanteSelectionne)
    
    ' Retour de l'API si Annulé -> Retour = 0
    Select Case retourAPI
    
    Case 0 'Abandon
        Exit Sub
    Case 1 ' OK
        adresseStructureDEVMODE = GlobalLock(imprimanteSelectionne.hDevMode)
        Call CopyMemory(infoDevice, ByVal adresseStructureDEVMODE, Len(infoDevice))

        nomImprimante = Left(infoDevice.dmDeviceName, InStr(1, infoDevice.dmDeviceName, Chr(NULL_PTR)) - 1)
        For Each imprimante In Printers
            If nomImprimante = imprimante.DeviceName Then
                Set Printer = imprimante
                Exit For
            End If
        Next
    Case Else 'an error occured
        MsgBox ("Erreur inatendue")
        Exit Sub
    End Select
    '
    ' Affectation des paramètres de configuration de l'imprimante
    Printer.Orientation = infoDevice.dmOrientation
    Printer.Copies = infoDevice.dmCopies
    ' etc...
    '
    ' Ecriture du texte en utilisant l'objet Printer
    Printer.Print "OK"
    RichTextBox1.SelPrint Printer.hdc
    Printer.EndDoc
    
    Exit Sub

Err_Impression:

End Sub