Microsoft 365 Ne pas ajuster la l'impression sur 1 page

[sebastien176]

Bonjour à tous,

Dans le fichier ci-joint, je souhaiterais que quand je clic sur le bouton impression, l'impression ne se fasse pas sur 1 seule et même page

J'ai mis le code ci-dessous dans le module 1 mais quand je clic sur le bouton, l'impression est ajustée sur 1 page
Ce qui rend le lecture des code barres (colonne D)impossible;

Je vous remercie par avance de votre aide

Sébastien

 

[danielco]

Bonjour,

Dans ce cas, il faut choisir l'option "Ajuster toutes les colonnes à une page".

Daniel

 

[Phil69970]

Bonjour à tous

@sebastien176

Je te propose

Sub Imprimer()
    Dim DerLigne As Variant
    Dim SaveName As String, wb As String
    wb = ActiveWorkbook.FullName
    DerLigne = Sheets("Zippage").Range("B65536").End(xlUp).Row
 
    ' définir la zone d'impression
'***** A remplacer
    'Sheets("Zippage").PageSetup.PrintArea = "A1:D" & DerLigne

'***** Par ceci
        With Sheets("Zippage").PageSetup
            .PrintArea = "A1:D" & DerLigne       'Zone d'impression de la feuille
            .Zoom = False
            .FitToPagesWide = 1

'************
            .FitToPagesTall = 2  '<== Nbre de page que tu souhaites ici tu auras 2 pages
'************

            'Réglage des marges
            .LeftMargin = Application.InchesToPoints(0.1)   'Marge gauche
            .RightMargin = Application.InchesToPoints(0.1)  'Marge droite
            .TopMargin = Application.InchesToPoints(0.1)    'Marge haut de page
            .BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
            '.Orientation = xlLandscape                      'Paysage
            .Orientation = xlPortrait                       'Portrait
        End With
'*****    


    ' imprimer
    'Sheets("Zippage").PrintOut
    Sheets("Zippage").PrintPreview
    ' efface les pointillés et gagne en performance
    Sheets("Zippage").DisplayAutomaticPageBreaks = False
    CreateObject("WScript.Shell").Popup "Document en cours d'impression", 1, "IMPRESSION DU DOCUMENT"
 
End Sub

*'Les commentaires dans le code VBA ressemblent à mes commentaires dans un précédent fichier

Merci de ton retour

 

[sebastien176]

Bonjour à tous

@sebastien176

Je te propose

Sub Imprimer()
    Dim DerLigne As Variant
    Dim SaveName As String, wb As String
    wb = ActiveWorkbook.FullName
    DerLigne = Sheets("Zippage").Range("B65536").End(xlUp).Row
 
    ' définir la zone d'impression
'***** A remplacer
    'Sheets("Zippage").PageSetup.PrintArea = "A1:D" & DerLigne

'***** Par ceci
        With Sheets("Zippage").PageSetup
            .PrintArea = "A1:D" & DerLigne       'Zone d'impression de la feuille
            .Zoom = False
            .FitToPagesWide = 1

'************
            .FitToPagesTall = 2  '<== Nbre de page que tu souhaites ici tu auras 2 pages
'************

            'Réglage des marges
            .LeftMargin = Application.InchesToPoints(0.1)   'Marge gauche
            .RightMargin = Application.InchesToPoints(0.1)  'Marge droite
            .TopMargin = Application.InchesToPoints(0.1)    'Marge haut de page
            .BottomMargin = Application.InchesToPoints(0.1) 'Marge bas de page
            '.Orientation = xlLandscape                      'Paysage
            .Orientation = xlPortrait                       'Portrait
        End With
'*****   


    ' imprimer
    'Sheets("Zippage").PrintOut
    Sheets("Zippage").PrintPreview
    ' efface les pointillés et gagne en performance
    Sheets("Zippage").DisplayAutomaticPageBreaks = False
    CreateObject("WScript.Shell").Popup "Document en cours d'impression", 1, "IMPRESSION DU DOCUMENT"
 
End Sub

*'Les commentaires dans le code VBA ressemblent à mes commentaires dans un précédent fichier

Merci de ton retour

Merci pour ta réponse
Pour les commentaires , il est fort probable que j'ai déniché ces code ici
J'ai refais le code comme ci-dessous et ça marche
Sub Imprimer_Palette()
With Feuil1
Dim DerLigne As Variant
Dim SaveName As String, wb As String
wb = ActiveWorkbook.FullName
DerLigne = Sheets("Prepa_Palette").Range("B65536").End(xlUp).Row

' définir la zone d'impression
Sheets("Prepa_Palette").PageSetup.PrintArea = "A1" & DerLigne

Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

'Aperçu avant impression
Sheets("Prepa_Palette").PrintPreview

' efface les pointillés et gagne en performance
Sheets("Prepa_Palette").DisplayAutomaticPageBreaks = False
CreateObject("WScript.Shell").Popup "Document en cours d'impression", 1, "IMPRESSION DU DOCUMENT"
End With
End Sub

 

[Phil69970]

@sebastien176

Je doute que ton code fonctionne avec le fichier du post #1

Pourquoi tout simplement car ton code ne parle pas de la même feuille !!!

Sheets("Prepa_Palette")

et le fichier du post #1

Mais as tu essayé mon code avec le fichier du post #1 ?? Non bien sur !!!
Car sinon tu aurais vu qu'il fonctionne !!!

Poser une question et mettre un fichier c'est bien mais ensuite mettre une solution avec un autre nom de feuille et sans rapport avec le fichier posté c'est un peu se moquer des personnes qui ont regardé le fichier et essayé de t'apporter une réponse.

 

[sebastien176]

@sebastien176

Je doute que ton code fonctionne avec le fichier du post #1

Pourquoi tout simplement car ton code ne parle pas de la même feuille !!!



et le fichier du post #1
Regarde la pièce jointe 1182053

Mais as tu essayé mon code avec le fichier du post #1 ?? Non bien sur !!!
Car sinon tu aurais vu qu'il fonctionne !!!

Poser une question et mettre un fichier c'est bien mais ensuite mettre une solution avec un autre nom de feuille et sans rapport avec le fichier posté c'est un peu se moquer des personnes qui ont regardé le fichier et essayé de t'apporter une réponse.

Bonjour Phil69970,
Oui tu as tout à fait raison, mais j'avais renommé la feuille avant
Ton code fonctionne aussi
Merci de ton retour