Impression optimisée de chaque page sans couper d'informations [Résolu]

Likith

XLDnaute Nouveau
Bonjour à tous!

Je plante depuis quelques jours sur le Vba et me trouvant coincé, je me permet de poster!

Mon document permet l'affichage de "bloc" d'informations sur une page de visualisation.
En fait, des infos sont contenues sur d'autres feuilles et ont fait venir celles qui nous intéressent en cochant une case.
On se retrouve donc avec une liste d'informations de longueur variable. (cf fichier joint)

Et c'est là que l'on souhaite imprimer!

J'ai trouvé ici et adapté une macro plutôt sympathique qui me permet d'imprimer avec la bonne échelle et sur plusieurs pages qui se suivent.
Problème : certaines informations se retrouvent coupées. De plus il me faut définir la longueur de la zone d'impression (ici fixée de A33 à K260)

Code:
Sub Macroimpressionbis()
Application.ScreenUpdating = False
   Range("A33:K260").Select
    ActiveSheet.PageSetup.PrintArea = "$A$33:$K$260"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.78740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 67
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
End Sub
(Range("A33:K260").Select ne sert à rien non?)


Je souhaite donc redéfinir la zone d'impression en fonction des informations importées et faire aussi en sorte que mes pages ne soient pas à cheval sur une information...

J'ai pensé à utiliser des "." présent dans la colonne A à la fin de chaque bloc d'information.
Je souhaite donc compléter ma macro pour que chaque page se termine par un "." détecté dans la colonne A. Le dernier point détecté dans la colonne A permettrai aussi de déterminer la longueur de la zone d'impression.

Je vais chercher dans ce sens!

Mais en attendant, si vous avez des informations, je suis preneurs!!

Merci d'avance à tous!!


*EDIT:
Voici comment je vois le début de la macro, seulement la ligne en gras ne fonctionne pas... ce qui est logique à cause de guillements autours de K, mais je ne connais pas la bonne syntaxe. Une idée?
Sub Macroimpression()
Application.ScreenUpdating = False
Dim DerLigne As Long
Sheets("Visualisation et impression").Activate
DerLigne = Range("A65536").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A34, "K" & DerLigne"
With
...
End With
ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
End Sub

*EDIT2:
Voilà, cela semble arranger le problème:
Sub Macroimpression()
Application.ScreenUpdating = False
Dim DerLigne As Long
Sheets("Visualisation et impression").Activate
DerLigne = Range("A65536").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A33:K" & DerLigne
With ActiveSheet.PageSetup
...
End With
ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
End Sub
Maintenant il faut que j'arrive à trouver une solution pour ne pas couper mes données...
Autrement dit, sachant que ma page ne peux contenir que 79 lignes, il faut que la macro vérifie la colonne A. Si à la 79ème ligne, la case ne comprend pas de point, il faut donc qu'elle remonte jusqu'à trouver un point. Quand elle en trouve, il faut donc qu'elle enclenche un saut de page (ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell).
De la, elle doit continuer à vérifier la colonne A 79 lignes après le saut de page. Et ainsi de suite...
Il faut arrêter la macro si elle dépasse la dernière case comprise sur la zone d'impression, en l'occurrence A & DerLigne.

Bon et maintenant, une idée pour le code?






Fichier joint:
fichier zip: Impression optimisée de chaque page sans couper d'informations.zip
 
Dernière édition:

Likith

XLDnaute Nouveau
Re : Impression optimisée de chaque page sans couper d'informations

Avec ceci, je me retrouve bien avec des sauts de pages mais pas au bon endroit...
Code:
Sub Macroimpression()
Application.ScreenUpdating = False
Dim DerLigne As Long
Sheets("Visualisation et impression").Activate
DerLigne = Range("A65536").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A34:K" & DerLigne

Dim Sautpage As Long
Sautpage = Range("A112").End(xlUp).Row
i = 79
While Sautpage < DerLigne
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Sautpage = Sautpage + i
Sautpage = Range("A" & Sautpage).End(xlUp).Row
Wend
With ActiveSheet.PageSetup
...
End Sub


*EDIT:
Et voila ma macro finale!
Je n'ai pas réussi à insérer d'image en face de "LeftHeader=" mais tant pis!
Code:
Sub Macroimpression()
Application.ScreenUpdating = False

'Supprime tout les sauts de pages préexistants
Sheets("Visualisation et impression").ResetAllPageBreaks

'Défini la plage de cellules à imprimer
Dim DerLigne As Long
Sheets("Visualisation et impression").Activate
DerLigne = Range("A65536").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "A34:K" & DerLigne

'Saute des pages pour ne pas couper d'informations au passage d'une nouvelle feuille
Dim Sautpage As Long
Sautpage = Range("A112").End(xlUp).Row
i = 77
While Sautpage < DerLigne
Cells(Sautpage, 1).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Sautpage = Sautpage + i
Sautpage = Range("A" & Sautpage).End(xlUp).Row
Wend


'Mise en page de la feuille
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = "&P / &N"
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.6)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 73
        .PrintErrors = xlPrintErrorsDisplayed
    End With

'Fonction d'impression
ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
End Sub


Bonne journée à tous!

*EDIT 2:
Je retombe sur ce sujet en cherchant autre chose...
Je n'ai pas réussi à insérer d'image en face de "LeftHeader=" mais tant pis!
Il suffit de mettre une image dans fichier->mise en page->En tête et pied de page
Puis dans la macro : LeftHeader = "&G"
Et voilà!
 
Dernière édition:

Discussions similaires