Option Explicit
Public oChoix As Integer
Public Sub MiseEnPage()
Dim Zmin As Integer, Zmax As Integer, Zmoy As Integer
Dim Zone As String, Orient As String
Dim oZoom As Integer
Dim L, H
Zmax = 400
Zmin = 80
'Choix de la zône en fonction du nombre d'étiquettes
UserForm1.Show
Select Case oChoix
Case 0 'pas de sélection
Exit Sub
Case 1 '1 étiquette
Zone = Sheets("Etiquette").Range("Zone_impr_4").Address
Case 2 '2 étiquettes
Zone = Sheets("Etiquette").Range("Zone_impr_3").Address
Case 3 '4 étiquettes
Zone = Sheets("Etiquette").Range("Zone_impr_2").Address
Case 4 '8 étiquettes
Zone = Sheets("Etiquette").Range("Zone_impr_1").Address
End Select
'Détermination Portrait/Payssage
L = Range(Zone).Width
H = Range(Zone).Height
If L > H Then
Orient = xlLandscape
Else
Orient = xlPortrait
End If
'Mise en page
Application.ScreenUpdating = False
With Feuil2.PageSetup
.PrintArea = Zone
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 0
.HeaderMargin = 0
.FooterMargin = 0
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = Orient
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.PrintErrors = xlPrintErrorsDisplayed
.Zoom = False 'mise sur une seule feuille
.FitToPagesTall = 1 'nécessaire pour la détermination
.FitToPagesWide = 1 'ultérieure du zoom
End With
'Déterminarion du zoom
Do While (Zmax - Zmin) > 1
Zmoy = Int((Zmax + Zmin) / 2)
Feuil2.PageSetup.Zoom = Zmoy
Feuil2.PageSetup.PrintArea = Zone ' réactualise indirectement les sauts de page
If Feuil2.HPageBreaks.Count = 0 And Feuil2.VPageBreaks.Count = 0 Then
Zmin = Zmoy
Else
Zmax = Zmoy
End If
Loop
Zmoy = Zmoy - 1 'marge pour les arrondis
Feuil2.PageSetup.Zoom = Zmoy
Application.ScreenUpdating = True
End Sub