ComboBox et Impression
Bonjour à tous,
Sur le fichier que j'alimente, j'ai pu trouver un code à l'aide du forum, qui me permette à l'aide d'une liste déroulante (par validation des données) de :
1. Sélectionner le doc voulu
2. Faire un aperçu avant impression
Le soucis : J'ai l'impression que la 1ère partie du code est longue et qu'il est possible de la simplifier parce que lorsque je démarre le code avec la ComboBox, il prend plus de temps qu'avec la validation des données et m'affiche un écran noir avant de pouvoir m'afficher l'aperçu avant impression.
De plus, je bloque au niveau de "tous les documents", il ne m'imprime qu'une page..
Je ne sais pas si avec la fonction "Case", ça pourrait fonctionner..
Merci encore pour votre retour
Private Sub ComboBox1_Change()
If ComboBox1 = "Doc1" Then
ActiveSheet.PageSetup.PrintArea = "A38:R77"
Flag = 2
GoSub SetPage
End If
If ComboBox1 = "Doc2" Then
ActiveSheet.PageSetup.PrintArea = "AE83:BQ153"
Flag = 1
GoSub SetPage
End If
If ComboBox1 = "Doc3" Then
ActiveSheet.PageSetup.PrintArea = "BS157:CJ198"
Flag = 2
GoSub SetPage
End If
If ComboBox1 = "Doc4" Then
ActiveSheet.PageSetup.PrintArea = "CL206:CO260"
Flag = 1
GoSub SetPage
End If
If ComboBox1 = "Tous les documents" Then
ActiveSheet.PageSetup.PrintArea = "A38:R77,BS157:CJ198"
Flag = 2
GoSub SetPage
Sheets("Feuil1!").PrintPreview
MsgBox "Appuyez sur Ok pour voir l'autre document"
ActiveSheet.PageSetup.PrintArea = "AE83:BQ153,CL206:CO260"
Flag = 1
GoSub SetPage
End If
Sheets("Feuil1!").PrintPreview
GoSub ImpPage
End
SetPage:
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = True
.Orientation = IIf(Flag = 2, xlLandscape, xlPortrait) '2 paysage ou 1 portrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = IIf(Flag = 2, 70, 77)
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
Return
ImpPage:
Rep = MsgBox("Voulez vous imprimez ce(s) document(s) : ", vbOKCancel, "ATTENTION")
If Rep = 1 Then
Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Application.PrintCommunication = False
End If
Return
End Sub
Bonjour,
Pouvez-vous m'aider svp ?
Je peux joindre un fichier si besoin
Merci encore à vous
Belle journée
Bonjour,
Oui, il est vivement conseillé de joindre un fichier
Par avance, merci.
Bonjour Bruno,
Merci pour votre retour. J'ai réussi à parfaire mon code VBA
Il fallait le supprimer et remettre le mettre (je ne sais pas si ça a un lien avec ActiveX...)
Mais merci ! Et prochaine fois, ça sera fichier dès le 1er message
Belle journée