Une bouteille de champ a celui qui trouve

Signaler
Messages postés
18
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
20 avril 2005
-
Messages postés
2
Date d'inscription
mercredi 15 février 2006
Statut
Membre
Dernière intervention
18 juillet 2013
-
Salut tous le monde.

Je previens ceux qui vont lire ce message que j'ai, avant de poster ce message , fait un nombre de recherche incalculable.

Mon problème est le suivant :

J'ai une imprimante qui est déclaré sur le réseau (je ne peut donc pas la déclaré X fois) qui est multi bac.

Mon but est de pouvoir imprimer via une macro ou VB sur du multi bac (une feuille sur un bac et une autre sur un autre bac).

La seule solution que j'ai trouvé pour le moment et qui n'est pas du tout acceptable est d'utilisé le Sendkey pour aller chercher les options.

Si ça peut aider sachez que l'imprimante ainsi que les drivers sont configuré de façon a ce qu'un type de paier different soit declaré sur chaque bac.

Celui qui me trouve une solution devient mon dieu :D
Et je lui envoi la bouteille par la poste :p

8 réponses

Messages postés
4172
Date d'inscription
mercredi 30 juillet 2003
Statut
Membre
Dernière intervention
9 juin 2006
27
Et avec les propriétés PaperBin et PaperSize de l'objet Printer, ça le fait pas ??

Christophe R.
Messages postés
521
Date d'inscription
mardi 24 décembre 2002
Statut
Membre
Dernière intervention
11 septembre 2008
5
Sur le site de VBFRANCE il y a un exemple qui correspond a tes besoins tu aurais du mieux chercher.

le titre : CHANGER LES PROPRIÉTÉS DE L'IMPRIMANTE EN COURS

voici le listing du code de cette exemple que j'ai repris, il faudra donc remercier l'auteur :

je l'ai testé (voir a la fin du code, je demande de changer du bac 3 vers le bac1 et de changer l'orinetation du papier en paysage au lieu de portrait.

ca marche, je suis donc OK pour la bouteille de champagne.

-creer un formulaire vide et y ajouter un bouton command1
et editer le code du formulaire vierge et coller ceci:

Private Const HWND_BROADCAST = &HFFFF
Private 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&
Private Const DMORIENT_PORTRAIT = &H1&
Private Const DMORIENT_LANDSCAPE = &H2&
Private Const DMPAPER_A4 = 9 ' A4 210 x 297 mm
Private Const DMPAPER_A5 = 11 ' A5 148 x 210 mm
Private Const DMPAPER_ENV_C5 = 28 ' Envelope C5 162 x 229 mm
Private Const DMPAPER_ENV_DL = 27 ' Envelope DL 110 x 220mm

Private 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

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

Private Declare Function GetLastError Lib "kernel32" () As Long

Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Private 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
Private 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
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private 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

Private Sub Command1_Click()
n = ChangePrinterSettings(DMPAPER_A4, 3, , DMORIENT_LANDSCAPE, 1)
MsgBox n
End Sub
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
75
Salut thierrydelepine
Le serveur pleure !
Il aurait été plus judicieux de passer l'url de la source ...

Vala
Jack
Messages postés
18
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
20 avril 2005

Merci merci ,

je vois ça demain au boulot et si ça marche non seulement je te serais redevable mais en plus faudras que tu me file ton adresse :)
Messages postés
18
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
20 avril 2005

Houla je suis carrement désolé mais j'ai oublié de préciser qu'il s'agissait d'une feuille excel que je voulais imprimer.

Et ce qui fait que le code que tu m'as filé marche pour une appli VB mais pas pour une feuille excel. :(
Messages postés
18
Date d'inscription
jeudi 2 janvier 2003
Statut
Membre
Dernière intervention
20 avril 2005

Je m'excuse car je viens de modifier certaine petite chose et effectivement avec quelque bidouille j'arrive à faire fonctionner ça avec excel .

Merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci merci :)

:kisses) :kisses) :kisses) :kisses) :kisses) :kisses) :kisses) :kisses) :kisses)

Je te dois une fiere chandelle (ainsi qu'une bouteille de champ :) )
Messages postés
18
Date d'inscription
lundi 28 octobre 2002
Statut
Membre
Dernière intervention
12 mars 2007

Bonjour

J'ai le même besoin pour imprimer dans un bac puis dans l'autre mais il me plante toutm le temps sur 'Err 9 : Débordement de tableau causé par un gestionnaire d'imprimante absent ou non accessible
Une idée ?

merci d'avance

Ludo
Messages postés
2
Date d'inscription
mercredi 15 février 2006
Statut
Membre
Dernière intervention
18 juillet 2013

Bonjour,
j'ai le même problème , mais je n'arrive pas à faire fonctionner le code avec excel
pouvez vous me dire les modifs que vous avez fait svp
merci d'avance de votre réponse