ComboBox et Impression

Le 07/09/2021 à 12:26

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

Le 08/09/2021 à 15:49

Bonjour,

Pouvez-vous m'aider svp ?

Je peux joindre un fichier si besoin

Merci encore à vous

Belle journée

Le 09/09/2021 à 00:57

Bonjour,

Oui, il est vivement conseillé de joindre un fichier

Par avance, merci.

Le 09/09/2021 à 15:27