Comment ne pas imprimer les objets (case à cocher et liste déroulante) d'une feuille de
calcul ?
Fais un clic droit sur les contrôles à ne pas imprimer, format de contrôle, propriété,
décocher imprimer l'objet.
décocher imprimer l'objet.
Philippe Bronchart,
Ajouté ou modifié le 19/05/2004 (N°1416)
Ajouté ou modifié le 19/05/2004 (N°1416)
Comment déterminer d'avance la taille exacte d'un graphique (en mm) sur la feuille
imprimée.
Sub DimGraph()
Dim Lg, Ht, Msg1, Msg2, Tte, LgStd, HtStd
Msg1 = "Quelle largeur en mm souhaitez-vous ?"
Msg2 = "Quelle hauteur en mm souhaitez-vous ?"
Tte = "Dimensions du graphique"
'largeur et hauteur standard d'un objet graphique incorporé
'en mm
LgStd = "107"
HtStd = "52,5"
Lg = InputBox(Msg1, Tte, LgStd)
If Lg = "" Then Exit Sub
Ht = InputBox(Msg2, Tte, HtStd)
On Error GoTo GesErr
With Selection
.Height = Ht * 2.925
.Width = Lg * 2.66
End With
Exit Sub
GesErr:
MsgBox "Vous devez d'abord sélectionner un graphique..."
Exit Sub
End Sub
nb:
Il faut pour chaque imprimante réaliser les ajustements nécessaires par tatonnement
en jouant sur les paramètres des lignes 15 et 16. Mais ensuite c'est tout bon !
tests réalisés sur Epson C60
Dim Lg, Ht, Msg1, Msg2, Tte, LgStd, HtStd
Msg1 = "Quelle largeur en mm souhaitez-vous ?"
Msg2 = "Quelle hauteur en mm souhaitez-vous ?"
Tte = "Dimensions du graphique"
'largeur et hauteur standard d'un objet graphique incorporé
'en mm
LgStd = "107"
HtStd = "52,5"
Lg = InputBox(Msg1, Tte, LgStd)
If Lg = "" Then Exit Sub
Ht = InputBox(Msg2, Tte, HtStd)
On Error GoTo GesErr
With Selection
.Height = Ht * 2.925
.Width = Lg * 2.66
End With
Exit Sub
GesErr:
MsgBox "Vous devez d'abord sélectionner un graphique..."
Exit Sub
End Sub
nb:
Il faut pour chaque imprimante réaliser les ajustements nécessaires par tatonnement
en jouant sur les paramètres des lignes 15 et 16. Mais ensuite c'est tout bon !
tests réalisés sur Epson C60
ChrisV,
Ajouté ou modifié le 16/05/2004 (N°1408)
Ajouté ou modifié le 16/05/2004 (N°1408)
Comment sélectionner exactement une plage dont la colonne A s'arrête à la ligne 10, la B à la
15, la C à la 12, la D à la 13? La sélection devrait donc être A1 à D15. Impossible d'utiliser
les instructions du type ligne = ActiveSheet.UsedRange.Rows.Count ou ligne =
Range("a1").CurrentRegion.Rows.Count, car des données, qui ne sont pas à imprimer,
sont en colonne E et seraient incluses avec les UsedRange ou CurrentRegion.
With Range("A:D")
Range("A1:D" & .Find("*", .Item(1), , , , xlPrevious).Row).Select
End With
Range("A1:D" & .Find("*", .Item(1), , , , xlPrevious).Row).Select
End With
Alain Vallon, (N°931)
Quelle commande faut-il utiliser pour imprimer depuis excel un document word en recto verso ?
TonDocument.PrintOut ManualDuplexPrint:=True
Laurent Longre, (N°930)
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 !
(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)
Comment faire sur excel pour n'imprimer que les pages paires ? (mon imprimante ne gère pas le
recto-verso...) puis toutes les impaires ?
Sub PagesPairesOuImpaires()
Dim i&, NbPages&, rep, PremierePage&
rep = MsgBox("Cliquer sur :" & vbLf & _
"- Oui pour imprimer les pages paires" & vbLf & _
"- Non pour imprimer les pages impaires" & vbLf & _
"- Annuler pour quitter sans rien faire.", vbYesNoCancel)
If rep = vbCancel Then Exit Sub
PremierePage = IIf(rep = vbYes, 2, 1)
NbPages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
For i = PremierePage To NbPages Step 2
ActiveSheet.PrintOut From:=i, To:=i, Preview:=False
Next i
End Sub
Ou, pour n'imprimer que certaines pages :
'-------------------------
Sub SelectionDePages()
Dim i&, Pages$, ArrPages
Pages = _
InputBox("Saisir les pages à imprimer sur ce modèle :" & vbLf & _
"1;2;3;12;14;25;33", "Pages à imprimer")
ArrPages = Split(Pages, ";")
For i = LBound(ArrPages) To UBound(ArrPages)
x=Clng(ArrPages(i))
ActiveSheet.PrintOut From:=x, to:=x, Preview:=False
Next i
End Sub
Dim i&, NbPages&, rep, PremierePage&
rep = MsgBox("Cliquer sur :" & vbLf & _
"- Oui pour imprimer les pages paires" & vbLf & _
"- Non pour imprimer les pages impaires" & vbLf & _
"- Annuler pour quitter sans rien faire.", vbYesNoCancel)
If rep = vbCancel Then Exit Sub
PremierePage = IIf(rep = vbYes, 2, 1)
NbPages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
For i = PremierePage To NbPages Step 2
ActiveSheet.PrintOut From:=i, To:=i, Preview:=False
Next i
End Sub
Ou, pour n'imprimer que certaines pages :
'-------------------------
Sub SelectionDePages()
Dim i&, Pages$, ArrPages
Pages = _
InputBox("Saisir les pages à imprimer sur ce modèle :" & vbLf & _
"1;2;3;12;14;25;33", "Pages à imprimer")
ArrPages = Split(Pages, ";")
For i = LBound(ArrPages) To UBound(ArrPages)
x=Clng(ArrPages(i))
ActiveSheet.PrintOut From:=x, to:=x, Preview:=False
Next i
End Sub
Frédéric Sigonneau,
Ajouté ou modifié le 25/10/2003 (N°928)
Ajouté ou modifié le 25/10/2003 (N°928)
Comment faire par un bouton une impression de feuille en spécifiant l'orientation du papier et
le % de l'impression. Les feuilles que je doit imprimer doivent etre en PAYSAGE et certaine
doivent être à 60% de leur valeurs normales, et d'autres à 100%.
Voici un exemple pour te mettre sur la piste, c'est à adapter et ça implique que
tu connaisses le ou les numéro de pages qui doivent être imprimés différemment
Sub Macro1()
Dim page
'pour la page 1 jusqu'à un total de xx pages calculer par le nombre
'de sauts de page horizontaux dans la feuille active
For page = 1 To Worksheets(1).HPageBreaks.Count
If page = 2 Then 'si c'est la page 2
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.Zoom = 95
ActiveWindow.SelectedSheets.PrintOut From:=page, To:=page
Else 'sinon pour les autre pages
ActiveSheet.PageSetup.Zoom = 100
End If
page = page + 1
Next
End Sub
tu connaisses le ou les numéro de pages qui doivent être imprimés différemment
Sub Macro1()
Dim page
'pour la page 1 jusqu'à un total de xx pages calculer par le nombre
'de sauts de page horizontaux dans la feuille active
For page = 1 To Worksheets(1).HPageBreaks.Count
If page = 2 Then 'si c'est la page 2
ActiveSheet.PageSetup.Orientation = xlLandscape
ActiveSheet.PageSetup.Zoom = 95
ActiveWindow.SelectedSheets.PrintOut From:=page, To:=page
Else 'sinon pour les autre pages
ActiveSheet.PageSetup.Zoom = 100
End If
page = page + 1
Next
End Sub
isabelle, (N°927)
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
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
***************************
Autre solution avec cette macro de Jacques
Sub Imprime()
FeuilleConvertir = "ConversionTableau"
ligneSource = 2 ' ligne de départ
largeurSource = 4 ' largeur source (nb colonnnes)
hpageDest = 65 ' hauteur de la page de destination
ncolDest = 2 ' nb colonnes destination
ligneDest = 2
'--------
nbenreg = Sheets(FeuilleConvertir).Cells(ligneSource,
1).CurrentRegion.Rows.Count
Sheets("edition").ResetAllPageBreaks
Sheets("edition").Cells.Clear
For col = 1 To ncolDest ' en têtes de colonne
Sheets(FeuilleConvertir).Cells(ligneSource - 1, 1).Resize(1,
largeurSource).Copy _
Sheets("edition").Cells(1, (col - 1) * largeurSource + 1)
Next col
'--
Do While Sheets(FeuilleConvertir).Cells(ligneSource, 1) <> ""
For col = 1 To ncolDest
Cells(ligneSource, 1).Resize(hpageDest, largeurSource).Copy _
Sheets("edition").Cells(ligneDest, (col - 1) * largeurSource +
1)
Sheets("edition").Cells(ligneDest, (col - 1) * _
largeurSource + 1).Resize(hpageDest, largeurSource).BorderAround
Weight:=xlThin
ligneSource = ligneSource + hpageDest
Next
'--
Sheets("edition").HPageBreaks.Add Before:=Cells(ligneDest +
hpageDest, 1)
ligneDest = ligneDest + hpageDest
Loop
Sheets("edition").Select
ActiveSheet.PrintPreview
End Sub
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
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
***************************
Autre solution avec cette macro de Jacques
Sub Imprime()
FeuilleConvertir = "ConversionTableau"
ligneSource = 2 ' ligne de départ
largeurSource = 4 ' largeur source (nb colonnnes)
hpageDest = 65 ' hauteur de la page de destination
ncolDest = 2 ' nb colonnes destination
ligneDest = 2
'--------
nbenreg = Sheets(FeuilleConvertir).Cells(ligneSource,
1).CurrentRegion.Rows.Count
Sheets("edition").ResetAllPageBreaks
Sheets("edition").Cells.Clear
For col = 1 To ncolDest ' en têtes de colonne
Sheets(FeuilleConvertir).Cells(ligneSource - 1, 1).Resize(1,
largeurSource).Copy _
Sheets("edition").Cells(1, (col - 1) * largeurSource + 1)
Next col
'--
Do While Sheets(FeuilleConvertir).Cells(ligneSource, 1) <> ""
For col = 1 To ncolDest
Cells(ligneSource, 1).Resize(hpageDest, largeurSource).Copy _
Sheets("edition").Cells(ligneDest, (col - 1) * largeurSource +
1)
Sheets("edition").Cells(ligneDest, (col - 1) * _
largeurSource + 1).Resize(hpageDest, largeurSource).BorderAround
Weight:=xlThin
ligneSource = ligneSource + hpageDest
Next
'--
Sheets("edition").HPageBreaks.Add Before:=Cells(ligneDest +
hpageDest, 1)
ligneDest = ligneDest + hpageDest
Loop
Sheets("edition").Select
ActiveSheet.PrintPreview
End Sub
Frédéric Sigonneau, Jacques Boisgontier, Isabelle, (N°926)
Comment faire pour que dans une feuille de calcul, des valeurs d'une cellule ne soit pas
imprimables?
Cette macro met en blanc le contenu des cellules à ne pas imprimer (à définir à
la première ligne) et ajoute un commentaire pour prévenir de ce fait.
Private
Sub Worksheet_Change(ByVal Target As Range)
[A1].ClearComments
If [A1] = "zaza" Or [A1] = "toto" Or [A1] = 100 Then
With [A1]
.Font.ColorIndex = 2
.AddComment
End With
With [A1].Comment
.Visible = False
.Text Text:= "" & Chr(10) & "attention : cette cellule ne sera pas imprimée."
End With
Else
[A1].Font.ColorIndex = xlAutomatic
End If
End Sub
la première ligne) et ajoute un commentaire pour prévenir de ce fait.
Private
Sub Worksheet_Change(ByVal Target As Range)
[A1].ClearComments
If [A1] = "zaza" Or [A1] = "toto" Or [A1] = 100 Then
With [A1]
.Font.ColorIndex = 2
.AddComment
End With
With [A1].Comment
.Visible = False
.Text Text:= "" & Chr(10) & "attention : cette cellule ne sera pas imprimée."
End With
Else
[A1].Font.ColorIndex = xlAutomatic
End If
End Sub
ChrisV, (N°925)
Je vois bien le symbole de l'euro dans l'aperçu avant impression d'excel mais il ne s'affiche
pas ...
Le symbole Euro s'imprime très facilement, mais seulement si l'imprimante reconnaît la police utilisée. Dans le cas ou l'imprimante ne reconnaît pas la police utilisée, il faut alors sélectionner dans les options de l'imprimante, le mode d'impression en caractères graphiques bitmap).
Le processus à mettre en oeuvre dépend de l'imprimante ( voici un exemple pour HP laserjet 4 )
Dans le menu Démarrer/paramètre/imprimantes Cliquer deux fois sur votre imprimante ( si vous en avez plusieurs, sélectionnez celle que vous utilisez) Dans le menu Fichier, sélectionnez propriété Sélectionnez l'onglet polices et choisissez "Téléchargez les polices true type en tant que polices logicielles bitmap" puis "ok"
Quelles sont les polices qui possèdent le symbole Euro sous Windows 95 ?
Si vous n'avez pas installé la version corrective Euro, effectuez les manipulations indiqués dans la question "Comment afficher le symbole de
l'Euro, sachant que mon système d'exploitation est Windows 95". Si vous avez installé la version corrective Euro, les 9 polices suivantes permettent l'utilisation du symbole Euro quelle que soit l'application utilisée sous Windows 95 (en appuyant simultanément sur Alt Gr et e ): Arial, Arial Black, Comic Sans MS, Courier New, Impact, MS Sans Serif, Tahoma, Times New Roman, Verdana.
Le processus à mettre en oeuvre dépend de l'imprimante ( voici un exemple pour HP laserjet 4 )
Dans le menu Démarrer/paramètre/imprimantes Cliquer deux fois sur votre imprimante ( si vous en avez plusieurs, sélectionnez celle que vous utilisez) Dans le menu Fichier, sélectionnez propriété Sélectionnez l'onglet polices et choisissez "Téléchargez les polices true type en tant que polices logicielles bitmap" puis "ok"
Quelles sont les polices qui possèdent le symbole Euro sous Windows 95 ?
Si vous n'avez pas installé la version corrective Euro, effectuez les manipulations indiqués dans la question "Comment afficher le symbole de
l'Euro, sachant que mon système d'exploitation est Windows 95". Si vous avez installé la version corrective Euro, les 9 polices suivantes permettent l'utilisation du symbole Euro quelle que soit l'application utilisée sous Windows 95 (en appuyant simultanément sur Alt Gr et e ): Arial, Arial Black, Comic Sans MS, Courier New, Impact, MS Sans Serif, Tahoma, Times New Roman, Verdana.
Microsoft, (N°924)
Bonjour sur un de mes documents il y a des lignes vides dont le nombre peut varier. Comment ne pas les imprimer ?
Cette macro te permet de masquer les lignes vides avant impression puis de les afficher à nouveau. Une ligne est considérée comme vide si la cellules A de la colonne est vide.
Sub suppr_Lv()
Application.ScreenUpdating = False
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(r, "A")) Then Rows(r).Hidden = True
Next r
ActiveSheet.PrintOut
Rows().Hidden = False
End Sub
Sub suppr_Lv()
Application.ScreenUpdating = False
For r = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(r, "A")) Then Rows(r).Hidden = True
Next r
ActiveSheet.PrintOut
Rows().Hidden = False
End Sub
ChrisV, (N°923)
Est-il possible d'insérer un logo sous forme d'image dans l'en-tête (mise en page) ?
une façon très simple de le faire, est de se servir de la première ligne du classeur comme en-tête de page. il faut insérer l'image ou le logo dans la première ligne et la définir comme ligne à répéter sur toute les feuilles dans Fichier, Mise en page, onglet "Feuille", Lignes à répéter en haut ( $1:$1 )
Isabelle, (N°922)
Comment personnaliser une mise en page d'un fichier excel tout en maximisant la rapidité
d'exécution ? Dès que je mets du code VBA pour cela, l'impression est terriblement longue.
Les macros XL4, toujours fonctionnelles sous excel 95, 97, 2000 et XP sont beaucoup plus rapides pour cela. Comme tout le monde ne sait pas (plus) comment les écrire, voici un classeur à télécharger qui fait le boulot !
Denis Michon, (N°921)
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
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)
Comment puis-je automatiquement insérer la date du dernier enregistrement dans le pied de page
des feuilles de mon classeur de base.
Il faut que tu utilises l'événement Before_Print comme suit:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.LeftFooter = ActiveWorkbook.BuiltinDocumentProperties _
("Last save time")
End Sub
Si tu veux que tous tes classeurs par défaut aient accès à cette macro, je te
suggère de partir d'un classeur vierge, auquel tu ajoutes cette macro et que tu enregistreras
sous le nom CLASS.XLT dans le répertoire de démarrage d'Excel
(quelque part sur ton disque dur, dans le répertoire xlstart).
Private Sub Workbook_BeforePrint(Cancel As Boolean)
ActiveSheet.PageSetup.LeftFooter = ActiveWorkbook.BuiltinDocumentProperties _
("Last save time")
End Sub
Si tu veux que tous tes classeurs par défaut aient accès à cette macro, je te
suggère de partir d'un classeur vierge, auquel tu ajoutes cette macro et que tu enregistreras
sous le nom CLASS.XLT dans le répertoire de démarrage d'Excel
(quelque part sur ton disque dur, dans le répertoire xlstart).
Laurent Mortezai, (N°919)