Ajustement automatique des largeurs de colonne pour impression d'un tableau

Le
Florent Bedecarrats
Bonjour à tous,

Je n'arrive pas à me connecter sur le sited'excelabo. Je ne sais pas si
c'est un problème du site ou de ma connexion (je suis en Bolivie).

Bref, je me souviens avoir vu sur le site un truc qui permettait d'ajuster
automatiquement les paramètres d'un tableau pour gagner de la place à
l'impression (j'en ai des dizaines d'énormes à imprimer et j'aimerais ne pas
tuer trop d'arbres).

Quelqu'un a t'il dans ces archives cette manip et peut-il me l'envoyer?

D'avance
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #4648071
Bonjour Florent,
Au bout de ce lien
http://www.excelabo.net/excel/imprimerdiv.php#impressionrapide
, on trouve des choses comme :
'=================================================================================='
Eviter les gâchis de papier.
Et pour répartir les données sur plus de deux colonnes ?
Peut-être cette adaptation du code d'isabelle pourrait-elle te convenir ?
La colonne à traiter est supposée être la colonne A . S'il y a d'autres
colonnes remplies dans la feuille, il faudrait peaufiner un peu. Le
traitement est effectué dans un nouveau classeur, sur une copie de la
feuille qui contient la colonne A.

For i = 1 To h
derLi = Columns(i).Find("*", , , , , xlPrevious).Row
If i = h Then
Range(Cells(x + 1, i), Cells(x, i)).Cut
Else
Range(Cells(x + 1, i), Cells(derLi, i)).Cut
End If
Cells(1, i + 1).Select
ActiveSheet.Paste
Next

[A1].Select
ActiveSheet.PrintPreview
End Sub
Frédéric Sigonneau, (N°920)

Impression recto verso
Comment imprimer en rectoverso avec excel ?
Il y a 2 solutions suivant que ton imprimante gère ou pas le recto-verso
(j'ai bien dit "gère" et pas forcément le fait toute seule)

A) L'imprimante gère:
1+ Menu Fichier > Mise en page
2+ Onglet Feuille > Cocher en bas "A droite puis vers le bas"
3+ Commencer l'impression à la page 2 sous peine de voir la page 1 au recto
de la première feuille
4+ Configurer l'imprimante pour le recto-verso (différent suivant le modèle)
5+ Lancer l'impression
6+ Imprimer la page 1 indépendamment

B) L'imprimante ne gère pas:
1+ Laisser le paramètre "Vers le bas puis à droite" (voir point A2)
2+ Imprimer l'impression des pages impaires (voir nota ci-dessous)
3+ Remettre le paquet de feuille dans l'imprimante (dans le bon sens !) en
prenant soin d'enlever la première page avant et de rajouter une page
blanche à la fin si nécessaire
4+ Lancer l'impression des pages paires (voir nota ci-dessous)

Nota : Dans cette solution, les pages pair et impair sont les numéros finaux
car avec cette solution, Excel les numérotent dans le sens traditionnel.
Pour donner un exemple :

Classeur (numéros de page Excel donc au point B2 de la page 1 à 4 puis en B4
de la page 5 à 8)
P1 P5
P2 P6
P3 P7
P4 P8

Feuilles imprimées (numérotation automatique impossible avec les entêtes)
P1 P2
P3 P4
P5 P6
P7 P8

Je pense que la plupart des imprimantes gèrent aujourd'hui le recto-verso
donc la solution A est plus simple et il y a moins de risques d'erreurs !
Eric Rogeon, (N°929)

ou encore :

Tasser les données à imprimer sur un nombre de pages réduit
Question : j'ai une série de données sur un petit nombre de colonnes mais un
très grand nombre de lignes. Quand j'imprime, je gache beaucoup de papier.
Comment sauver les arbres ?
Solution d'Isabelle :
Si toutes les lignes ont la même hauteur

Sub nbLigne()
Dim hpb, x, i, h, k
Set hpb = ActiveSheet.HPageBreaks(1)
x = hpb.Location.Row - 1
h = Application.Ceiling(Columns(1).Find("*", , , , , xlPrevious).Row / x, 1)
k = "D"
For i = 1 To h
Range("A" & (x * i) + 1 & ":C" & (x * i) + x).Cut
If k = "D" Then
Range("D" & 1 + Application.CountA(Range("D:D"))).Select
ActiveSheet.Paste
k = "A"
Else
Range("A" & Range("A:A").SpecialCells(xlCellTypeBlanks).Row).Select
ActiveSheet.Paste
k = "D"
End If
Next
End Sub

Et enfin

La solution de Frédéric Sigonneau

Le code ci-dessous est à recopier dans un module standard du classeur qui
comprend
les colonnes à redistribuer ou dans le perso.xls pour un usage plus général
(non lié à un classeur particulier).

La procédure FormatDécoupeColonnes peut être affectée à un bouton
personnalisé d'une
barre d'outils. Elle commence par recueillir les paramètres souhaité de
redécoupage
des colonnes, par l'intermédiaire de 3 boites de dialogue.
La première permet de sélectionner à la souris *une* cellule de *chacune*
des
colonnes à formater. Il est possible de sélectionner des cellules contigües
ou non.
La deuxième définit le nombre de colonnes par page souhaité dans le résultat
à
imprimer. Dans ton exemple, tu pourrais ici entrer "9", ce qui réduirait
grosso modo
des 2/3 le nombre de pages à imprimer.
La troisième permet de décider si, après redécoupage, l'impression est
lancée
directement ou si un aperçu avant impression est affiché (recommandé pour
vérifier et
au besoin modifier la mise en page, en particulier les marges).
Une fois ces paramètres recueillis et rappelés pour confirmation, le
traitement est
lancé (c'est la procédure ImprimeEnColonnes qui s'en charge). Le résultat
est entré
dans une feuille ajoutée au classeur.

Limites :
Ces procédures sont destinées à traiter des données entrées ou importées
dans une
feuille "au kilomètre", sans mise en forme. Elles ne tiennent aucun compte
d'une
éventuelle mise en page de la feuille (contrairement aux solutions proposées
par
Isabelle et Benead).
Le découpage s'effectue sur le bloc entier des données. Tes 7000 lignes, par
exemple,
vont être coupées en 3 blocs de 2300 lignes (en gros) qui vont être collés
côte à
côte. La cohérence éventuelle des données n'est pas conservée dans les pages
imprimées. Par ex., la page 1 comprendra les lignes 1 à 80 des 3 colonnes,
puis, à
côté, les lignes 2300 à 2380, puis les lignes 4700 à 4780, etc.

Option Explicit

Sub FormatDécoupeColonnes()
Dim nSource As Range, nCol%, VoirOuPrint$, tmp$, pos%
Dim derLi&, colCount%, Msg$, Action$

On Error GoTo fin
'choix des colonnes à découper
Msg = "Sélectionnez une cellule dans chacune" & vbLf
Msg = Msg & "des colonnes à découper." & vbLf
Msg = Msg & "Les colonnes sélectionnées peuvent être" & vbLf
Msg = Msg & "contigues ou non." & vbLf
Msg = Msg & "(Exemples : $1 ou $1:$1 ou $1;$1, etc.)"
Set nSource = Application.InputBox(prompt:=Msg, Default:="$1", Type:=8)
If nSource.Rows.Count <> 1 Then GoTo fin

'nombre de colonnes à obtenir
derLi = nSource.Range("A65500").End(xlUp).Row
colCount = nSource.Count
Msg = "Vous avez sélectionné " & colCount & " colonne(s) de " _
& derLi & " lignes." & vbLf
Msg = Msg & "Au lieu de " & colCount & ", combien voulez-vous" & _
" obtenir" & vbLf & "de colonnes par page à l'impression ?" & vbLf
Msg = Msg & vbLf & "Entrez un multiple de " & colCount & " :"
nCol = Application.InputBox(prompt:=Msg, Type:=1)

'que faire en fin de traitement
Msg = "Que voulez-vous faire en fin de traitement :" & vbLf
Msg = Msg & "Pour imprimer le résultat, tapez ""P"" ou ""p""" & vbLf
Msg = Msg & "Pour un aperçu avant impression, tapez ""A"" ou ""a"""
VoirOuPrint = Application.InputBox(prompt:=Msg, Default:="A", Type:=2)
If UCase(VoirOuPrint) = "P" Then
Action = "lancer l'impression"
Else: Action = "afficher un aperçu avant impression"
End If

'confirmation
Msg = "Nombre de colonnes à découper : " & colCount & vbLf
Msg = Msg & "Présentation du résultat : " & _
nCol & " colonnes par page" & vbLf
Msg = Msg & "Après redécoupage : " & Action & vbLf
Msg = Msg & vbLf & "Continuer ?"

If MsgBox(Msg, vbOKCancel) = vbCancel Then Exit Sub

'procédure de traitement
ImprimeEnColonnes nSource, nCol, VoirOuPrint
Exit Sub
fin:
If MsgBox("Paramètres incorrects ou incomplets. Recommencer ?", _
vbYesNo) = vbYes Then
FormatDécoupeColonnes
End If
End Sub

Sub ImprimeEnColonnes(ByVal Source As Range, _
ByVal nbCol As Byte, _
ByVal Aperçu As String)
Dim FeuilleSource As Worksheet, FeuilleDest As Worksheet, Msg$
Dim derLi&, derCol%, colCount%, i&, liDep&, colDep%, liCount%
Dim ratio%, nbLiDecoupe&, reste%, y%, destAdresse$

On Error GoTo fin

'récupération des paramètres
liDep = Source.Range("A1").Row
colDep = Source.Range("A1").Column
derLi = Source.Range("A65500").End(xlUp).Row
colCount = Source.Count
liCount = liDep + derLi - 1
ratio = nbCol / colCount
nbLiDecoupe = Int(liCount / ratio)
reste = liCount - (nbLiDecoupe * ratio)

'préparation de la feuille de résultat
Set FeuilleSource = ActiveWorkbook.ActiveSheet
Application.ScreenUpdating = False
Set FeuilleDest = ActiveWorkbook.Worksheets.Add

'copie des colonnes à traiter
FeuilleSource.Activate
FeuilleSource.Range(Source.Address).EntireColumn.Select
Selection.Copy
FeuilleDest.Activate
FeuilleDest.Range("A1").PasteSpecial xlPasteAll
FeuilleDest.Range("A1").Select

'nouvelles coordonnées
colDep = 1
derCol = colDep + colCount - 1
destAdresse = Range(Cells(1, 1), Cells(1, derCol)).Address

With ActiveSheet
'découpage
i = 1
For y = 1 To ratio
If y = ratio Then nbLiDecoupe = nbLiDecoupe + reste
.Range(Cells(i, colDep), _
Cells(i + nbLiDecoupe - 1, derCol)).Select
Selection.Copy
.Cells(1, (y * colCount) + 1).PasteSpecial xlPasteAll
i = i + nbLiDecoupe
Next y

'minimum de mise en forme
.Range(destAdresse).EntireColumn.Delete
.UsedRange.Columns.AutoFit
.Range("A1").Select

'sortie du résultat
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Exit Sub
fin:
MsgBox "Erreur"
Application.ScreenUpdating = True
End Sub

Tu peux aussi voir si tu parviens à te connecter chez Frédéric :
http://frederic.sigonneau.free.fr/Impr.htm
--
Avec plaisir
Philippe.R
"Florent Bedecarrats" news:O%
Bonjour à tous,

Je n'arrive pas à me connecter sur le sited'excelabo. Je ne sais pas si
c'est un problème du site ou de ma connexion (je suis en Bolivie).

Bref, je me souviens avoir vu sur le site un truc qui permettait d'ajuster
automatiquement les paramètres d'un tableau pour gagner de la place à
l'impression (j'en ai des dizaines d'énormes à imprimer et j'aimerais ne
pas tuer trop d'arbres).

Quelqu'un a t'il dans ces archives cette manip et peut-il me l'envoyer?

D'avance



Florent Bedecarrats
Le #4663251
Merci beaucoup Philippe!


"Philippe.R"
Bonjour Florent,
Au bout de ce lien
http://www.excelabo.net/excel/imprimerdiv.php#impressionrapide
, on trouve des choses comme :
'=================================================================================='
Eviter les gâchis de papier.
Et pour répartir les données sur plus de deux colonnes ?
Peut-être cette adaptation du code d'isabelle pourrait-elle te convenir ?
La colonne à traiter est supposée être la colonne A . S'il y a d'autres
colonnes remplies dans la feuille, il faudrait peaufiner un peu. Le
traitement est effectué dans un nouveau classeur, sur une copie de la
feuille qui contient la colonne A.

For i = 1 To h
derLi = Columns(i).Find("*", , , , , xlPrevious).Row
If i = h Then
Range(Cells(x + 1, i), Cells(x, i)).Cut
Else
Range(Cells(x + 1, i), Cells(derLi, i)).Cut
End If
Cells(1, i + 1).Select
ActiveSheet.Paste
Next

[A1].Select
ActiveSheet.PrintPreview
End Sub
Frédéric Sigonneau, (N°920)

Impression recto verso
Comment imprimer en rectoverso avec excel ?
Il y a 2 solutions suivant que ton imprimante gère ou pas le recto-verso
(j'ai bien dit "gère" et pas forcément le fait toute seule)

A) L'imprimante gère:
1+ Menu Fichier > Mise en page
2+ Onglet Feuille > Cocher en bas "A droite puis vers le bas"
3+ Commencer l'impression à la page 2 sous peine de voir la page 1 au
recto
de la première feuille
4+ Configurer l'imprimante pour le recto-verso (différent suivant le
modèle)
5+ Lancer l'impression
6+ Imprimer la page 1 indépendamment

B) L'imprimante ne gère pas:
1+ Laisser le paramètre "Vers le bas puis à droite" (voir point A2)
2+ Imprimer l'impression des pages impaires (voir nota ci-dessous)
3+ Remettre le paquet de feuille dans l'imprimante (dans le bon sens !) en
prenant soin d'enlever la première page avant et de rajouter une page
blanche à la fin si nécessaire
4+ Lancer l'impression des pages paires (voir nota ci-dessous)

Nota : Dans cette solution, les pages pair et impair sont les numéros
finaux
car avec cette solution, Excel les numérotent dans le sens traditionnel.
Pour donner un exemple :

Classeur (numéros de page Excel donc au point B2 de la page 1 à 4 puis en
B4
de la page 5 à 8)
P1 P5
P2 P6
P3 P7
P4 P8

Feuilles imprimées (numérotation automatique impossible avec les entêtes)
P1 P2
P3 P4
P5 P6
P7 P8

Je pense que la plupart des imprimantes gèrent aujourd'hui le recto-verso
donc la solution A est plus simple et il y a moins de risques d'erreurs !
Eric Rogeon, (N°929)

ou encore :

Tasser les données à imprimer sur un nombre de pages réduit
Question : j'ai une série de données sur un petit nombre de colonnes mais
un très grand nombre de lignes. Quand j'imprime, je gache beaucoup de
papier. Comment sauver les arbres ?
Solution d'Isabelle :
Si toutes les lignes ont la même hauteur

Sub nbLigne()
Dim hpb, x, i, h, k
Set hpb = ActiveSheet.HPageBreaks(1)
x = hpb.Location.Row - 1
h = Application.Ceiling(Columns(1).Find("*", , , , , xlPrevious).Row / x,
1)
k = "D"
For i = 1 To h
Range("A" & (x * i) + 1 & ":C" & (x * i) + x).Cut
If k = "D" Then
Range("D" & 1 + Application.CountA(Range("D:D"))).Select
ActiveSheet.Paste
k = "A"
Else
Range("A" & Range("A:A").SpecialCells(xlCellTypeBlanks).Row).Select
ActiveSheet.Paste
k = "D"
End If
Next
End Sub

Et enfin

La solution de Frédéric Sigonneau

Le code ci-dessous est à recopier dans un module standard du classeur qui
comprend
les colonnes à redistribuer ou dans le perso.xls pour un usage plus
général
(non lié à un classeur particulier).

La procédure FormatDécoupeColonnes peut être affectée à un bouton
personnalisé d'une
barre d'outils. Elle commence par recueillir les paramètres souhaité de
redécoupage
des colonnes, par l'intermédiaire de 3 boites de dialogue.
La première permet de sélectionner à la souris *une* cellule de *chacune*
des
colonnes à formater. Il est possible de sélectionner des cellules
contigües ou non.
La deuxième définit le nombre de colonnes par page souhaité dans le
résultat à
imprimer. Dans ton exemple, tu pourrais ici entrer "9", ce qui réduirait
grosso modo
des 2/3 le nombre de pages à imprimer.
La troisième permet de décider si, après redécoupage, l'impression est
lancée
directement ou si un aperçu avant impression est affiché (recommandé pour
vérifier et
au besoin modifier la mise en page, en particulier les marges).
Une fois ces paramètres recueillis et rappelés pour confirmation, le
traitement est
lancé (c'est la procédure ImprimeEnColonnes qui s'en charge). Le résultat
est entré
dans une feuille ajoutée au classeur.

Limites :
Ces procédures sont destinées à traiter des données entrées ou importées
dans une
feuille "au kilomètre", sans mise en forme. Elles ne tiennent aucun compte
d'une
éventuelle mise en page de la feuille (contrairement aux solutions
proposées par
Isabelle et Benead).
Le découpage s'effectue sur le bloc entier des données. Tes 7000 lignes,
par exemple,
vont être coupées en 3 blocs de 2300 lignes (en gros) qui vont être collés
côte à
côte. La cohérence éventuelle des données n'est pas conservée dans les
pages
imprimées. Par ex., la page 1 comprendra les lignes 1 à 80 des 3 colonnes,
puis, à
côté, les lignes 2300 à 2380, puis les lignes 4700 à 4780, etc.

Option Explicit

Sub FormatDécoupeColonnes()
Dim nSource As Range, nCol%, VoirOuPrint$, tmp$, pos%
Dim derLi&, colCount%, Msg$, Action$

On Error GoTo fin
'choix des colonnes à découper
Msg = "Sélectionnez une cellule dans chacune" & vbLf
Msg = Msg & "des colonnes à découper." & vbLf
Msg = Msg & "Les colonnes sélectionnées peuvent être" & vbLf
Msg = Msg & "contigues ou non." & vbLf
Msg = Msg & "(Exemples : $1 ou $1:$1 ou $1;$1, etc.)"
Set nSource = Application.InputBox(prompt:=Msg, Default:="$1", Type:=8)
If nSource.Rows.Count <> 1 Then GoTo fin

'nombre de colonnes à obtenir
derLi = nSource.Range("A65500").End(xlUp).Row
colCount = nSource.Count
Msg = "Vous avez sélectionné " & colCount & " colonne(s) de " _
& derLi & " lignes." & vbLf
Msg = Msg & "Au lieu de " & colCount & ", combien voulez-vous" & _
" obtenir" & vbLf & "de colonnes par page à l'impression ?" & vbLf
Msg = Msg & vbLf & "Entrez un multiple de " & colCount & " :"
nCol = Application.InputBox(prompt:=Msg, Type:=1)

'que faire en fin de traitement
Msg = "Que voulez-vous faire en fin de traitement :" & vbLf
Msg = Msg & "Pour imprimer le résultat, tapez ""P"" ou ""p""" & vbLf
Msg = Msg & "Pour un aperçu avant impression, tapez ""A"" ou ""a"""
VoirOuPrint = Application.InputBox(prompt:=Msg, Default:="A", Type:=2)
If UCase(VoirOuPrint) = "P" Then
Action = "lancer l'impression"
Else: Action = "afficher un aperçu avant impression"
End If

'confirmation
Msg = "Nombre de colonnes à découper : " & colCount & vbLf
Msg = Msg & "Présentation du résultat : " & _
nCol & " colonnes par page" & vbLf
Msg = Msg & "Après redécoupage : " & Action & vbLf
Msg = Msg & vbLf & "Continuer ?"

If MsgBox(Msg, vbOKCancel) = vbCancel Then Exit Sub

'procédure de traitement
ImprimeEnColonnes nSource, nCol, VoirOuPrint
Exit Sub
fin:
If MsgBox("Paramètres incorrects ou incomplets. Recommencer ?", _
vbYesNo) = vbYes Then
FormatDécoupeColonnes
End If
End Sub

Sub ImprimeEnColonnes(ByVal Source As Range, _
ByVal nbCol As Byte, _
ByVal Aperçu As String)
Dim FeuilleSource As Worksheet, FeuilleDest As Worksheet, Msg$
Dim derLi&, derCol%, colCount%, i&, liDep&, colDep%, liCount%
Dim ratio%, nbLiDecoupe&, reste%, y%, destAdresse$

On Error GoTo fin

'récupération des paramètres
liDep = Source.Range("A1").Row
colDep = Source.Range("A1").Column
derLi = Source.Range("A65500").End(xlUp).Row
colCount = Source.Count
liCount = liDep + derLi - 1
ratio = nbCol / colCount
nbLiDecoupe = Int(liCount / ratio)
reste = liCount - (nbLiDecoupe * ratio)

'préparation de la feuille de résultat
Set FeuilleSource = ActiveWorkbook.ActiveSheet
Application.ScreenUpdating = False
Set FeuilleDest = ActiveWorkbook.Worksheets.Add

'copie des colonnes à traiter
FeuilleSource.Activate
FeuilleSource.Range(Source.Address).EntireColumn.Select
Selection.Copy
FeuilleDest.Activate
FeuilleDest.Range("A1").PasteSpecial xlPasteAll
FeuilleDest.Range("A1").Select

'nouvelles coordonnées
colDep = 1
derCol = colDep + colCount - 1
destAdresse = Range(Cells(1, 1), Cells(1, derCol)).Address

With ActiveSheet
'découpage
i = 1
For y = 1 To ratio
If y = ratio Then nbLiDecoupe = nbLiDecoupe + reste
.Range(Cells(i, colDep), _
Cells(i + nbLiDecoupe - 1, derCol)).Select
Selection.Copy
.Cells(1, (y * colCount) + 1).PasteSpecial xlPasteAll
i = i + nbLiDecoupe
Next y

'minimum de mise en forme
.Range(destAdresse).EntireColumn.Delete
.UsedRange.Columns.AutoFit
.Range("A1").Select

'sortie du résultat
If UCase(Aperçu) = "P" Then
.PrintOut
Else
.PrintPreview
End If
End With
Exit Sub
fin:
MsgBox "Erreur"
Application.ScreenUpdating = True
End Sub

Tu peux aussi voir si tu parviens à te connecter chez Frédéric :
http://frederic.sigonneau.free.fr/Impr.htm
--
Avec plaisir
Philippe.R
"Florent Bedecarrats" de news:O%
Bonjour à tous,

Je n'arrive pas à me connecter sur le sited'excelabo. Je ne sais pas si
c'est un problème du site ou de ma connexion (je suis en Bolivie).

Bref, je me souviens avoir vu sur le site un truc qui permettait
d'ajuster automatiquement les paramètres d'un tableau pour gagner de la
place à l'impression (j'en ai des dizaines d'énormes à imprimer et
j'aimerais ne pas tuer trop d'arbres).

Quelqu'un a t'il dans ces archives cette manip et peut-il me l'envoyer?

D'avance







Publicité
Poster une réponse
Anonyme