Macro pour choix entre 2 fonctions imprimantes avec Excel

Bonsoir

Pas de souci, je vais être moins disponible aussi.

Voici un nouveau code :
http://cjoint.com/?CCdt3AAibTI

Le but est d'ajouter pas mal de choses dans la fenêtre d'exécution pour essayer de trouver le problème.
On devrait avoir deux ou trois pages de texte pour un essai d'impression.

Bonne semaine.

Merci encore de ta patience.

Je suis un peu moins disponible en ce moment car j'ai la garde de mes petits-enfants durant toute la semaine mais je vais continuer à venir voir tes réponses tous les jours car j'aimerais tellement avoir une macro qui fonctionne...!

A nouveau échec... Je te mets ci-dessous le résultat de la fenêtre Exécution :

Imprimante : 'Canon MG5300 series Printer WS'Bac par défaut avant 1 : 0 276          Sélection automatique 7            Réceptacle arrière 267          Cassette 269          Alimentation en continu 270          Allocation de papier

Le soleil est enfin là cet après-midi ! Nous nous rendons au manège... Je pense qu'il fera meilleur qu'hier.

Bonjour

Dans le code, il manque effectivement le passage sur le bac arrière.

je vous remets tout le code que j'ai un peu organisé entre-temps :
http://cjoint.com/?CCdjH2wyGRW
Espérons que je ne l'aie pas trop réorganisé, c'est un peu délicat avec une imprimante de modèle différent.

Merci pour la fenêtre d'exécution, d'après ces éléments, il y aurait un autre problème, il faudrait le début de la trace aussi.
Vous refaites un essai avec le nouveau code.
Après avoir vidé le contenu de cette fenêtre
(mettre le curseur dans la fenêtre, CTRL+A, Supp), lancez uniquement la macro ImprimerBacArriere.
Il faudrait tout le contenu de cette fenêtre : CTRL+A, Ctrl+C, puis CTRL+V dans la réponse.
Merci

Bon Dimanche, on nous annonce du soleil !

L'impression se fait à nouveau sans message d'erreur mais toujours à partir de la cassette.

Je te remets le code entier afin d'être certaine que j'aie bien remplacé ce qu'il fallait :

Option ExplicitDim NomImpr As String' D'après : http://www.vbfrance.com/codes/CHANGER-PROPRIETES-IMPRIMANTE-COURS\_7485.aspxPublic NomsBacs() As StringPublic NumerosBacs() As IntegerPublic Type PRINTER_DEFAULTS    pDatatype As Long    pDevMode As Long    DesiredAccess As LongEnd TypePublic Const HWND_BROADCAST = &HFFFFPublic Const WM_WININICHANGE = &H1APrivate Const CCHDEVICENAME = 32Private Const CCHFORMNAME = 32Private Const STANDARD_RIGHTS_REQUIRED = &HF0000Private Const PRINTER_ACCESS_ADMINISTER = &H4Private Const PRINTER_ACCESS_USE = &H8Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)Private Const PRINTER_ATTRIBUTE_DEFAULT = 4Private Const DM_MODIFY = 8Private Const DM_IN_BUFFER = DM_MODIFYPrivate Const DM_COPY = 2Private Const DM_OUT_BUFFER = DM_COPYPrivate Const DMDUP_SIMPLEX = 1Private Const DMDUP_VERTICAL = 2Private Const DMDUP_HORIZONTAL = 3Private Const DM_DUPLEX = &H1000&Private Const DM_DEFAULTSOURCE = &H200Private 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 mmPublic Const DMPAPER_A5 = 11                            '  A5 148 x 210 mmPublic Const DMPAPER_ENV_C5 = 28                '  Envelope C5 162 x 229 mmPublic Const DMPAPER_ENV_DL = 27                '  Envelope DL 110 x 220mmPrivate Const DC_BINNAMES = 12Private Const DC_BINS = 6  ' pour les bacsConst PRINTER_ENUM_CONNECTIONS = &H4Const PRINTER_ENUM_LOCAL = &H2Private 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 onlyEnd TypePublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Public Declare Function GetLastError Lib "kernel32" () As LongPrivate Declare Function DeviceCapabilities Lib "winspool.drv" _    Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _    ByVal dev As Long) As LongPublic Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As LongPublic Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As LongPublic 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 LongPublic Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As LongPublic Declare Function AbortDoc Lib "gdi32" (ByVal hdc As Long) As LongPrivate 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 LongPrivate Function ChangePrinterSettings(ByRef pOldBin As Integer, 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(NomImpr, 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(NomImpr, 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        'Bac        If pNewBin > 0 And pNewBin < 5 Then            pOldBin = .dmDefaultSource            .dmDefaultSource = pNewBin        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, NomImpr, 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    ' Vérifier le bac par défaut    ' (Recopie du code du début)     ' ... 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    Debug.Print "Nouvelle valeur du bac par défaut : " & NewDevMode.dmDefaultSource              ' Fermeture du handler de l'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 SelectEnd FunctionPrivate Function CodeBacParDefaut() As Integer    Dim hPrinter As Long           ' Handle de l'imprimante    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(NomImpr, 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(NomImpr, 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    ' Vérifier le bac par défaut     ' ... 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    Debug.Print "Nouvelle valeur du bac par défaut : " & NewDevMode.dmDefaultSource    CodeBacParDefaut = NewDevMode.dmDefaultSource      ' Fermeture du handler de l'imprimante    ClosePrinter (hPrinter)    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    CodeBacParDefaut = 0End FunctionPrivate Sub ListeBacsImpr()' Mémorise les noms et les numéros de bacs de l'imprimante NomImpr' http://support.microsoft.com/kb/194789   Dim Port As String   Dim NbBacs As Long   Dim ct As Long   Dim ListeDesNoms As String   Dim ch1 As String   Dim ch2 As String   Dim ch3 As String       ' le paramètre dc_bins permet d'obtenir le nombre de bacs de papier    NbBacs = DeviceCapabilities(NomImpr, Port, DC_BINS, ByVal vbNullString, 0)    If NbBacs <= 0 Then      MsgBox "L'imprimante : '" & NomImpr & "' n'a pas de bacs.", vbCritical      End    End If        ReDim NomsBacs(1 To NbBacs)    ReDim NumerosBacs(1 To NbBacs)    ListeDesNoms = String(24 * NbBacs, 0)    'Récupère les codes numériques des bacs    NbBacs = DeviceCapabilities(NomImpr, 0, DC_BINS, NumerosBacs(1), 0)    ' Récupère les noms des bacs    NbBacs = DeviceCapabilities(NomImpr, Port, DC_BINNAMES, ByVal ListeDesNoms, 0)    ' les noms des bacs sont mis dans le tableau Bacs    For ct = 1 To NbBacs       ch1 = Mid(ListeDesNoms, 24 * (ct - 1) + 1, 24)       ch2 = Left(ch1, InStr(1, ch1, Chr(0)) - 1)       'ch3 = String(6 - Len(CStr(NumerosBacs(ct))), " ") & NumerosBacs(ct)       Debug.Print NumerosBacs(ct), ch2       NomsBacs(ct) = ch2    Next ct    End SubSub BacArriere()' ***** A adapterConst nomBac = "Réceptacle arrière"Dim i As IntegerDim Ancien As IntegerDim NumBac As IntegerListeBacsImprNumBac = 0For i = 1 To UBound(NomsBacs)  If NomsBacs(i) = nomBac Then NumBac = iNextIf NumBac = 0 Then  MsgBox "Imprimante : " & NomImpr & "  Nom de bac inexistant : " & nomBac, vbCritical  EndEnd If' Retourne le numéro du bac affecté dans Ancien' et affecte NumBacCall ChangePrinterSettings(Ancien, NumerosBacs(NumBac))' Affiche le bac par défautEnd SubSub BacCassette()' ***** A adapterConst nomBac = "Cassette"Dim i As IntegerDim Ancien As IntegerDim NumBac As IntegerListeBacsImprNumBac = 0For i = 1 To UBound(NomsBacs)  If NomsBacs(i) = nomBac Then NumBac = iNextIf NumBac = 0 Then  MsgBox "Imprimante : " & NomImpr & "  Nom de bac inexistant : " & nomBac, vbCritical  EndEnd If' Retourne le numéro du bac affecté dans Ancien' et affecte le code du bacCall ChangePrinterSettings(Ancien, NumerosBacs(NumBac))End SubSub BacManuel()' ***** A adapterConst nomBac = "Chargeur manuel"Dim i As IntegerDim Ancien As IntegerDim NumBac As IntegerListeBacsImprNumBac = 0For i = 1 To UBound(NomsBacs)  If NomsBacs(i) = nomBac Then NumBac = iNextIf NumBac = 0 Then  MsgBox "Imprimante : " & NomImpr & "  Nom de bac inexistant : " & nomBac, vbCritical  EndEnd If' Retourne le numéro du bac affecté dans Ancien' et affecte le code du bacCall ChangePrinterSettings(Ancien, NumerosBacs(NumBac))End SubSub ImprimerBacArriere()Dim app As ApplicationDim Nom1 As StringDim p As IntegerSet app = ApplicationNom1 = app.ActivePrinterp = InStr(Nom1, " sur ")If p <= 0 ThenNomImpr = Nom1ElseNomImpr = Left(Nom1, p - 1)End IfDebug.Print "Imprimante : '" & NomImpr & "'"Select Case Application.NameCase "Microsoft Word"' Word expression.PrintOut(Background, Append, Range, OutputFileName,'   From, To, Item, Copies, Pages, PageType, PrintToFile, Collate, FileName,'   ActivePrinterMacGX, ManualDuplexPrint, PrintZoomColumn, PrintZoomRow, PrintZoomPaperWidth, PrintZoomPaperHeight)  ' Outils / références  Microsoft Word 14.0 Library  'ActiveDocument.PrintOutCase "Microsoft Excel"' Excel expression.PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName)  ' Outils / références  Microsoft Excel 14.0 Library  ActiveSheet.PrintOutCase "Microsoft PowerPoint"' Powerpoint  expression.PrintOut(From, To, PrintToFile, Copies, Collate) ' Outils / références  Microsoft PowerPoint 14.0 Library  'ActivePresentation.PrintOutCase Else  MsgBox " Application : " & Application.Name & " non programmée. "  End SelectDebug.Print "Bac par défaut avant 2 : " & CodeBacParDefaut'Changement de bacBacCassette' vérifier le bac par défautDebug.Print "Bac par défaut après 2 : " & CodeBacParDefautEnd Sub

Voici le message de la fenêtre d'exécution :

Imprimante : 'Canon MG5300 series Printer WS'Bac par défaut avant 2 : 0 276          Sélection automatique 7            Réceptacle arrière 267          Cassette 269          Alimentation en continu 270          Allocation de papierNouvelle valeur du bac par défaut : 267Bac par défaut après 2 : 0

Très bonne nuit