paramétrer le driver d'impression avec VBA

Matt51140

XLDnaute Nouveau
Bonjour le forum,

Au boulot nous avons une imprimante couleur paramétrée sur N&B. Est-il possible via VBA de passer temporairement l'imprimante (donc d'agir sur le driver) en couleur sans passer par la fenêtre des propriétés de l'imprimante ?

j'ai essayé avec l'enregistreur de macro mais cela ne donne rien.

Merci d'avance.

Matt.
 

Matt51140

XLDnaute Nouveau
Re : paramétrer le driver d'impression avec VBA

Bonjour,

Malheureusement j'ai déjà essayé et cela ne fonctionne pas (pardon d'avoir omis ce fait). D'après ce que je comprends de cette instruction, on ordonne à excel de sortir la feuille en couleur mais en arrivant sur l'imprimante le pilote de celle ci prends la main.
 

Roland_M

XLDnaute Barbatruc
Re : paramétrer le driver d'impression avec VBA

bonjour,

un code à adapter mais déjà bien fournit:

Code:
'Déclarer Public LPTZoneImpression$ LPTOrientationPage LPTSautDePage
'ou les passer dans l'appel avec les autres variables (Feuil$, MsgEntete$, ...)
'INIT AVANT APPEL:
'LPTZoneImpression$ = au Range()
'LPTOrientationPage = xlPortrait/xlLandscape
'LPTSautDePage = 0/1 si (0)sans (1)avec

Public LPTZoneImpression$, LPTOrientationPage, LPTSautDePage

Public Sub ImprimerCetteFeuil(Feuil$, MsgEntete$)
Application.ScreenUpdating = False
Dim EtatFullScreen As Boolean: EtatFullScreen = Application.DisplayFullScreen
On Error GoTo ErrLPT: Err.Clear

'----- mise en page -----------
Sheets(Feuil$).Select
With ActiveSheet.PageSetup
    .Zoom = False 'pas true sinon FitToPagesTall invalide
  If LPTSautDePage Then
    .FitToPagesTall = False 'permet le saut de page si trop haut
  Else
    .FitToPagesTall = 1 'impose sur la hauteur de la page
  End If
    .FitToPagesWide = 1 'impose sur la largeur de la page(toujours)
  If LPTOrientationPage Then .Orientation = LPTOrientationPage Else .Orientation = xlPortrait
    .CenterHorizontally = False
    .CenterVertically = False
  If LPTZoneImpression$ > "" Then .PrintArea = LPTZoneImpression$ 'sinon page entière
    .LeftHeader = MsgEntete$: .CenterHeader = "": .RightHeader = ""
    .LeftFooter = "": .CenterFooter = "": .RightFooter = ""
  If MsgEntete$ > "" Then .TopMargin = Application.CentimetersToPoints(FPointsParPixel) Else .TopMargin = 0
    .LeftMargin = 0: .RightMargin = 0: .HeaderMargin = 0: .BottomMargin = 0: .FooterMargin = 0
End With

'--- appel boîte DialogPrint ----
Application.ScreenUpdating = True
'If Val(Application.Version) >= 12 And EtatFullScreen = True Then Application.DisplayFullScreen = False
Application.DisplayFullScreen = False
Application.Dialogs(xlDialogPrint).Show
Application.DisplayFullScreen = EtatFullScreen
On Error GoTo 0: Err.Clear: Exit Sub

ErrLPT: 'traitement erreur ------
Application.ScreenUpdating = True
Application.DisplayFullScreen = EtatFullScreen
Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg$, vbCritical, "", Err.HelpFile, Err.HelpContext
On Error GoTo 0: Err.Clear: Exit Sub
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 389
Messages
2 087 933
Membres
103 678
dernier inscrit
bibitm