Impression pleine hauteur/largeur
Hello !
Je cherche à imprimer un couple tableau + graphique de manière à ce que ça remplisse la feuille, peu importe la taille de feuille utilisée (disons du A4 au A0).
J'ai testé quelques trucs comme le code ci-dessous, mais apparemment sans succès (sur de grands formats je me retrouve avec une majorité d'espace vide).
Private Sub CommandButton2_Click()
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub
Dois-je voir avec .HPageBreaks.Count et .VPageBreaks.Count ?
Bon, j'ai trouvé un palliatif, mais ce n'est pas très propre (zoom * 1.41 à chaque saut de taille (A4->A3->A2...).
A noter que mon truc bug pour A2 à A0, sans doute l'imprimante virtuelle qui déconne sur ces formats.
Private Sub CommandButton3_Click()
Dim Zoomm As Integer
Dim Taille As String
On Error Resume Next 'evite une erreur d'absence d'imprimante
If Application.Dialogs(xlDialogPrinterSetup).Show = False Then Exit Sub
On Error GoTo 0
Application.ScreenUpdating = False
UserForm2.Show
Taille = UserForm2.ComboBox1.Value
If Taille = "A4" Then
Zoomm = 100
Sheets("Grand_Tableau").PageSetup.PaperSize = xlPaperA4
End If
If Taille = "A3" Then
Zoomm = 141
Sheets("Grand_Tableau").PageSetup.PaperSize = xlPaperA3
End If
If Taille = "A2" Then
Zoomm = 199
Sheets("Grand_Tableau").PageSetup.PaperSize = xlPaperA2
End If
If Taille = "A1" Then
Zoomm = 280
Sheets("Grand_Tableau").PageSetup.PaperSize = xlPaperA1
End If
If Taille = "A0" Then
Zoomm = 395
Sheets("Grand_Tableau").PageSetup.PaperSize = xlPaperA0
End If
With Sheets("Grand_Tableau")
With .PageSetup
.Orientation = xlLandscape 'paysage
.CenterHorizontally = True 'centré horizontalement
.CenterVertically = True 'centré verticalement
.LeftMargin = Application.InchesToPoints(0) 'marge gauche
.RightMargin = Application.InchesToPoints(0) 'marge droite
.TopMargin = Application.InchesToPoints(0) 'marge haut
.BottomMargin = Application.InchesToPoints(0) 'marge bas
.HeaderMargin = Application.InchesToPoints(0.19) 'marge tout en haut
.FooterMargin = Application.InchesToPoints(0.19) 'marge tout en bas
.Zoom = Zoomm
.Draft = False
.BlackAndWhite = False
End With
.PrintPreview
'.PrintOut 'imprime
End With
Application.ScreenUpdating = True
End Sub