Vba excel impression - faire tenir les données sur moins de pages

Soyez le premier à donner votre avis sur cette source.

Snippet vu 13 161 fois - Téléchargée 35 fois

Contenu du snippet

Imaginons que sous Excel, vous ayez plein de lignes à imprimer, que tout celà tienne sur plusieurs pages.
Avec cette procédure, vous faites tenir tout çà sur moins de pages.

En utilisant les limites d'impression des pages Excel, on redécoupe les tableaux de données pour qu'ils se placent les uns à coté des autres, et prennent ainsi moins de place à l'impression.

Source / Exemple :


Sub DispatchRowsToColumns()
Dim rCol As Range
Dim rCell1 As Range, rCell2 As Range
Dim i As Integer, iPBcount As Integer
Dim Sht As Worksheet

Application.ScreenUpdating = False

Set Sht = ActiveSheet
Set rCol = Sht.UsedRange.Columns(1)

     Sht.PageSetup.PrintArea = ""
     Sht.PageSetup.Zoom = 100
     ActiveWindow.View = xlPageBreakPreview

' On compte le nombre de pages nécessaires à l'impression
iPBcount = Sht.HPageBreaks.Count

 On Error Resume Next
 ' Tant qu'il y a des page breaks, on boucle
    For i = 1 To iPBcount
        ' On positionne une cellule au début d'une page
        Set rCell1 = Sht.HPageBreaks(i).Location
        ' On positionne une deuxième cellule au début de la page suivante (-1 case),
        ' c'est-à-dire à la fin de la page courante
        Set rCell2 = Sht.HPageBreaks(i + 1).Location.Offset(-1, 0)
            If rCell2 Is Nothing Then
                ' On se trouve sur la dernière page. On colle tout le reste
                ' dans la colonne suivante.
                Range(rCell1, rCol.Cells(65536, 1).End(xlUp)).Cut _
                 Destination:=Sht.Cells(1, i + 1)
            Else
                ' On coupe la selection, et on la colle à partir de la
                ' ligne 1, dans la colonne suivante.
                Range(rCell1, rCell2).Cut Destination:=Sht.Cells(1, i + 1)
            End If
        ' C'est fini, on nettoie tout !
        Set rCell1 = Nothing
        Set rCell2 = Nothing
    Next i
  On Error GoTo 0
  
  ActiveWindow.View = xlNormalView
  Application.ScreenUpdating = True
  Sht.DisplayPageBreaks = False
  Application.Goto rCol.Cells(1, 1), True
  Set rCol = Nothing
End Sub

A voir également

Ajouter un commentaire

Commentaires

Messages postés
2
Date d'inscription
lundi 24 janvier 2005
Statut
Membre
Dernière intervention
26 octobre 2005

Excellent guide pour apprendre à maîtriser l'impression. Grande clarté des commentaires. J'aimerais trouver plus souvent des exemples de cette qualité.

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.