'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