Comment imprimer un grand tableau excel?

Version imprimable

Voir 40 message(s) de cette discussion en une page

29/04/2009, 10h24
azerty1956

Bonjour casefayere,

je viens d'essayer ton code, il est bien réfléchi et léger...

pour les 2 premières lignes ou figure à la fois la catégorie et la clès je souhaite les découper de la même manière que le reste du tableau Head Head1 et Head2....
Je suis la dessus maintenant, quoique je ne vois pas comment je pourrais suivre le raisonnement de ton code vu que l'on se localisait grace à la couleur alors que dans ce cas je souhaite récupérer les deux lignes dans le bloc Head.....donc les couleurs ne vont pas intervenir à mon avis...

@+
29/04/2009, 22h50
casefayere

Bonsoir Azerty,

Là, je n'ai pas compris ce que tu veux obtenir, ne pourrais-tu pas joindre une image du résultat attendu dans la feuille d'impression

a +
30/04/2009, 18h00
azerty1956

1 pièce(s) jointe(s)

Bonjour casefayere,

c'est fait je t'ai mis ci-joint le tableau.

voir les noms des blocs : Sheet1Head1, Sheet1Head2, et Sheet1Head3
(tjrs dans l'optique de mettre 50 colonnes par blocs)

Je te remercie d'avance pour l'aide

@+
30/04/2009, 22h00
casefayere

Bonsoir Azerty ,re le forum,

Je viens de m'apercevoir d'une bourde formidable avec ce que tu voudrais pour les en-têtes en décalant de 50 colonnes,

au hasard, cette formule ne peut pas marcher

Code:

RefersToR1C1:="=sheet1!R1C5:R2C55"

pour la bonne raison que sur ta ligne 1, ce sont des cellules fusionnées donc le nom attribué va jusqu'au bout de la cellule fusionnée, ça fausse complétement mon raisonnement que je croyais au point pour t'aider à nommer ces plages

aye aye aye, là je vais caler

bonne nuit
01/05/2009, 23h46
azerty1956

Bonsoir casefayere,

Justement dans l'exemple, j'ai "défusionné" les cellules de la ligne 1....je pensais que c'était plus simple de coder dans le cas de cellules non fusionnées.

Je ne sais pas si on peut créer des blocs pour chaque catégorie (Allant jusqu'au bout de la cellule fusionnée comme tu viens de le préciser)

A ce moment la, il faudra changer le code précédent pour ne pas prendre 50 colonnes à chaque coup mais plutôt le nombre de colonnes de chaque catégorie (= nombre de colonnes inséré dans les blocs intégrant la ligne 1&2) . Cette méthode sera de loin la plus adapté pour atteindre mes objectifs...

Je pensais que ça n'était pas faisable...
est ce que c'est le cas?

Je te remercie pour tes interventions bien réfléchies casefayere...

Bonne nuit

@+
02/05/2009, 12h34
casefayere

Bonjour Azerty, re le forum,

Ce que tu demande doit être possible mais je crois qu'il faut tout repensé,

Il fait beau dehors, j'ai du travail dans le jardin, il faut que j'en profite mais je vais réfléchir à ta nouvelle idée....patience

Bon Weed-end
05/05/2009, 10h26
azerty1956

Merci casefayere
si tu peux m'aider dans un pemier temps à nommer des blocs tous les 50 colonnes pour la ligne 1 & 2....(Head1, Head2.....) je ne sais pas comment m y prendre..
Après on verra bien pour les blocs par catégorie pour les cellules fusionnées..

Merci pour ton aide précieuse

@+

Bonsoir Azerty, le forum,
pour tes blocs "entetes"
Bon, je défusionne tes cellules en ligne 1 (il faut les laisser défusionnées)

j'ai ce code pour creer les blocs

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub entetes()
Dim dernierecolonne As Integer, x As Integer, w As Integer, nbblocs As Integer
dernierecolonne = ActiveSheet.Range("IV2").End(xlToLeft).Column
nbblocs = Int((dernierecolonne - 4) / 50)
w = 3
For x = 1 To nbblocs
x = (50 * x) + 5
If dernierecolonne >= x = (50 * x) + 55 Then
ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & x + 49 & ""
w = w + 1
Else
ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & dernierecolonne & ""
Exit For
End If
Next x
End Sub

ce code, on l'appelle à l'interieur de l'autre procédure pour les autres blocs, après :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
.....
'alimente les deux tableaux debut et fin des noms à définir
z = 1
ReDim deb(2)
ReDim fin(2)
deb(1) = 3
'/////////////////////////////////////////////////////////////////////////////////
'Pour 1er entete
ActiveWorkbook.Names.Add Name:="Sheet1Head1", RefersToR1C1:="=sheet1!R1C1:R2C3"
'pour 2eme entete
ActiveWorkbook.Names.Add Name:="Sheet1Head2", RefersToR1C1:="=sheet1!R1C5:R2C54"
'pour suivants
entetes 'il est ici
'//////////////////////////////////////////////////////////////////////////////////
 
For x = 3 To DerniereLigne
If Range("a" & x).Interior.ColorIndex = 48 Then ' code couleur
......

si tu as compris ma démarche, on pourras continuer

j'espère que tu as compris que j'ai fait une macro à part pour les entetes, pour la clarté de ta compréhension mais on pourra l'intégrer dans la macro "blocs", ça c'est toi qui décideras

Bonne journée

Rebonjour Casefayere,

Pour le code du dernier blocs, le code me définit un nom d'un bloc qui englobe ttes les colonnes de la colonne 1 à la dernière colonne??
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub entetes() Dim dernierecolonne As Integer, x As Integer, w As Integer, nbblocs As Integer dernierecolonne = ActiveSheet.Range("IV2").End(xlToLeft).Column nbblocs = Int((dernierecolonne - 4) / 50) + 2 w = 3 For x = 1 To nbblocs x = (50 * x) + 5 If dernierecolonne >= x = (50 * x) + 55 Then ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & x + 49 & "" w = w + 1 Else ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & dernierecolonne & "" Exit For End If Next x End Sub
Je suis en train d'essayer de comprendre ta démarche...

Pour le deuxième bloc :
Code:

1 2 'pour 2eme entete ActiveWorkbook.Names.Add Name:="Sheet1Head2", RefersToR1C1:="=Main!R1C5:R2C54"
Je ne comprends pas pourquoi le deuxième bloque s'arrête à la dernière colonne de ma feuille ( au lieu de s'arrêter à la 54 colonne comme définit dans la ligne de code)

Voila voila :)
Merci d'avance

07/05/2009, 11h24
casefayere

Bonjour azerty,
ce que tu écris m'étonne car j'ai essayé le code avant et vérifié sans problème, je ne peux pas regarder maintenant, je ne l'ai pas sous les yeux

bonne journée
07/05/2009, 18h38
azerty1956

oui ca marche pour les deux premiers blocs.
il ya juste un problème au niveau du dernier bloc (bloc 3) qui est définir pour =Sheet1!R1C1:R2C99

allez à plutard, boncourage pour ton boulot

J'essaye de comprendre le code,
d'ailleurs je voulais définir les blocs toute les 20 colonnes et j'ai fait des modifications au niveau du code (voir ci-joint) il doit y avoir quelquechose que je n'ai pas modifié ( notamment pour le dernier blocs ou je n'ai pas trop compris )

voila le code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Option Base 1 'n'oublies pas ça
Sub Bloc()
Dim x As Integer, w As Integer, m As Integer, f As String, z As Integer, deb() As Integer, fin() As Integer, y As Integer, s As Integer
Dim separ As String
Dim DerniereLigne As Integer
Dim DerniereColonne As Integer
Dim nbblocs As Integer
'Dim mysheet As Worksheet 'ça, je ne vois pas l'utilité
'Set mysheet = Sheets("sheet1") 'ça, je ne vois pas l'utilité
 
 DerniereLigne = ActiveSheet.Range("D65536").End(xlUp).Row
 DerniereColonne = ActiveSheet.Range("IV2").End(xlToLeft).Column
'**************************************************************
nbblocs = Int((DerniereColonne - 4) / 20) + 2 'si la division retourne une décimale
'***************************************************************
 
'alimente les deux tableaux debut et fin des noms à définir
z = 1
ReDim deb(2)
ReDim fin(2)
deb(1) = 3
 
For x = 3 To DerniereLigne
If Range("a" & x).Interior.ColorIndex = 48 Then ' code couleur
deb(z + 1) = Range("a" & x).Row
fin(z) = Range("a" & x - 1).Row
z = z + 1
ReDim Preserve deb(z + 1)
ReDim Preserve fin(z + 1)
End If
Next x
'****************************************************
fin(z) = DerniereLigne
'*************************************************************************
'Pour 1er entete
ActiveWorkbook.Names.Add Name:="sheet1Head1", RefersToR1C1:="=sheet1!R1C1:R2C3"
'pour le premier bloc car tu en aura 1 d'office
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C1:R" & fin(x) & "C3" & ""
ActiveWorkbook.Names.Add Name:="sheet1" & separ & "1", RefersToR1C1:=f
Next x
'******************************************************************
'pour 2eme entete
ActiveWorkbook.Names.Add Name:="sheet1Head2", RefersToR1C1:="=sheet1!R1C5:R2C25"
'pour le deuxième bloc car tu en aura 1 d'office
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C5:R" & fin(x) & "C25" & ""
ActiveWorkbook.Names.Add Name:="sheet1" & separ & "2", RefersToR1C1:=f
Next x
'***************************************************************************
'pour suivants entetes
w = 3
For m = 1 To nbblocs
y = (20 * m) + 5
If DerniereColonne >= m = (20 * m) + 25 Then
ActiveWorkbook.Names.Add Name:="sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & m & ":R2C" & x + 19 & ""
w = w + 1
Else
ActiveWorkbook.Names.Add Name:="sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & m & ":R2C" & DerniereColonne & ""
Exit For
End If
Next m
'pour le reste
For y = 56 To DerniereColonne Step 20
s = 3
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C" & y & ":R" & fin(x) & "C" & y + 20 & ""
ActiveWorkbook.Names.Add Name:="sheet1" & separ & s, RefersToR1C1:=f
Next x
s = s + 1
Next y
'Set mysheet = Nothing 'ça, je ne vois pas l'utilité
 
End Sub

je n'ai pas compris cette ligne d'ailleurs

Code:

For y = 56 To DerniereColonne Step 20

Je n'ai pas compris cette partie nonplu

Code:

1
2
3
4
5
6
7
'pour suivants entetes
w = 3
For m = 1 To nbblocs
y = (20 * m) + 5
If DerniereColonne >= m = (20 * m) + 25 Then
ActiveWorkbook.Names.Add Name:="sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & m & ":R2C" & x + 19 & ""
w = w + 1

Merci d'avance casefayere

Bonjour,
ah, tu me fais réfléchir avec tes codes:D,
ci-dessous, une version revue pour tes entetes, j'ai corrigé des erreurs (que j'avais faites), une fois qu'on sera d'accord la-dessus, on réintégrera ce code dans la procédure blocs pour éviter des déclarations de variables inutiles ou il faudra mettre toutes les variables en début de module (avant les codes) et les déclarer public, pour l'histoire de toutes les vingt colonnes, je corrigerai également la procédure blocs
dans sub bloc :
Code:

1 2 3 4 5 6 'Pour 1er entete ActiveWorkbook.Names.Add Name:="Sheet1Head1", RefersToR1C1:="=sheet1!R1C1:R2C3" 'pour 2eme entete ActiveWorkbook.Names.Add Name:="Sheet1Head2", RefersToR1C1:="=sheet1!R1C5:R2C24" 'pour suivants entetes
et
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub entetes() Dim dernierecolonne As Integer, x As Integer, w As Integer, nbblocs As Integer, y As Integer dernierecolonne = ActiveSheet.Range("IV2").End(xlToLeft).Column nbblocs = Int((dernierecolonne - 4) / 20) w = 3 x = 25 For x = 25 To dernierecolonne + 20 If dernierecolonne < x + 19 Then ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & dernierecolonne & "" Exit For Else ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & x + 19 & "" End If w = w + 1 x = (20 * (w - 2)) + 4 Next x End Sub
Bonne journée

Je continue à travailler et fait le ménage,

le fichier que tu m'as laissé et que j'ai pris comme base est joint.
attention, il n'y a plus de cellules fusionnées sinon ça ne fonctionnera pas pour les entetes

toujours en considérant tes blocs de 20 colonnes, code complet :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
Option Base 1 'n'oublies pas ça
Sub Bloc()
Dim x As Integer, w As Integer, DerniereLigne As Integer, dernierecolonne As Integer
Dim z As Integer, deb() As Integer, fin() As Integer, y As Integer
Dim separ As String, f As String
'***************************************************************
DerniereLigne = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
dernierecolonne = ActiveSheet.Range("IV2").End(xlToLeft).Column
'/////////////////////////////////////////////////////////////////////////////////
'Pour 1er entete
ActiveWorkbook.Names.Add Name:="Sheet1Head1", RefersToR1C1:="=sheet1!R1C1:R2C3"
'pour 2eme entete
ActiveWorkbook.Names.Add Name:="Sheet1Head2", RefersToR1C1:="=sheet1!R1C5:R2C24"
'pour suivants
w = 3
For x = 25 To dernierecolonne + 20
If dernierecolonne < x + 19 Then
ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & dernierecolonne & ""
Exit For
Else
ActiveWorkbook.Names.Add Name:="Sheet1Head" & w, RefersToR1C1:="=sheet1!R1C" & x & ":R2C" & x + 19 & ""
End If
w = w + 1
x = (20 * (w - 2)) + 4
Next x
'//////////////////////////////////////////////////////////////////////////////////
'alimente les deux tableaux debut et fin des noms à définir
z = 1
ReDim deb(2)
ReDim fin(2)
deb(1) = 3
'***************************************************************
For x = 3 To DerniereLigne
If Range("a" & x).Interior.ColorIndex = 48 Then ' code couleur
deb(z + 1) = Range("a" & x).Row
fin(z) = Range("a" & x - 1).Row
z = z + 1
ReDim Preserve deb(z + 1)
ReDim Preserve fin(z + 1)
End If
Next x
'*******************************************************************
fin(z) = DerniereLigne
'*************************************************************************
'pour le premier bloc car tu en auras 1 d'office
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C1:R" & fin(x) & "C3" & ""
ActiveWorkbook.Names.Add Name:="sheet1" & separ, RefersToR1C1:=f
Next x
'******************************************************************
'pour le deuxième bloc car tu en auras 1 d'office
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C5:R" & fin(x) & "C24" & ""
ActiveWorkbook.Names.Add Name:="sheet" & "2" & separ, RefersToR1C1:=f
Next x
'***************************************************************************
'pour le reste
y = 25
For x = 1 To UBound(deb, 1)
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C" & y & ":R" & fin(x) & "C" & y + 19 & ""
ActiveWorkbook.Names.Add Name:="sheet" & x + 2 & separ, RefersToR1C1:=f
y = y + 20
If y >= dernierecolonne - 19 Then
Exit For
End If
Next x
w = x + 3
'*************************************************************************
'pour la derniere colonne
For x = 1 To UBound(deb, 1) - 1
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C" & y & ":R" & fin(x) & "C" & dernierecolonne & ""
ActiveWorkbook.Names.Add Name:="sheet" & w & separ, RefersToR1C1:=f
Next x
 
End Sub

10/05/2009, 23h02
azerty1956

Bonsoir casefayere,

Si je ne t'ai pas répondu, c'est que j'attendais d'essayer ce code sur mon vrai grand tableau pour voir si ça marche, pour être sur de ne pas te poser des questions "bêtes"....J'ai essayé sur le tableau exemple mais ça ne me donne pas tous les blocs dont j'ai besoin....j'attends de l'essayer sur mon vrai tableau (que je n'ai pas sur mon pc personnel) et je te tiens au courant demain matin...

Merci d'avance pour ton aide...
A demain

Bonne soirée
11/05/2009, 09h50
Fouinette85

Personnellement pour imprimer le tableau j'aurais simplement "figer les volets"
avec une macro pour que le scroll et l'impression se fasse automatiquement si tu as souvent à réimprimer ton tableau mais ce n'est pas très compliqué.

Bonjour Casefayere,

Je viens de tester la le code :

Pour les Head c'est parfait le code me défini les blocs comme il faut.

Pour les autres, je pense qu'il y a un problème au niveau de cette partie du code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 'pour le reste y = 25 For x = 1 To UBound(deb, 1) separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_") f = "" & "=sheet1!R" & deb(x) & "C" & y & ":R" & fin(x) & "C" & y + 19 & "" ActiveWorkbook.Names.Add Name:="sheet1" & separ & x + 2, RefersToR1C1:=f y = y + 20 If y >= dernierecolonne - 19 Then Exit For End If Next x w = x + 3
En effet, j'obtient toujours les 2 premiers blocs comme il faut...le problème se situe au niveau des autres blocs.

Exemple de ce que j'obtient :

sheet1ARBI1 sheet1ARBI2 sheet1ARBI5 sheet1ARBI6 (blocs 3 et 4 manquent)

ou encore

sheet1CASH1 sheet1CASH2 sheet1CASH6 (blocs 3 & 4 &5 manquent)

Je pense que si tu teste le code sur l'exemple, tu auras le même résultat.

Merci pour ton aide encore,
@+

11/05/2009, 09h58
azerty1956

Mon tableau est susceptible de changer Fouinette85,
Est ce que ta méthode marche dans ce cas la?
Si oui, est ce que tu peux expliciter encore plus.

Merci pour l'intervention.

Bonjour Azerty,

essayes comme ça, mais je n'ai pas le temps de tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
'pour le reste
y = 25
w = 3
For x = 1 To UBound(deb, 1)
separ = Application.WorksheetFunction.Substitute(Range("a" & deb(x)).Value, "-", "_")
f = "" & "=sheet1!R" & deb(x) & "C" & y & ":R" & fin(x) & "C" & y + 19 & ""
ActiveWorkbook.Names.Add Name:="sheet" & w & separ, RefersToR1C1:=f
y = y + 20
w = w + 1
If y >= dernierecolonne - 19 Then
Exit For
End If
Next x
w = x + 3

11/05/2009, 10h13
Fouinette85

1 pièce(s) jointe(s)

Figer les volets consiste juste à conserver ta première ligne et/ou ta première colonne. Ce qui te permettrais d'imprimer tes données en gardant tes en tête de lignes et/ou colonne.
Je te join ton fichier avec les volets figer, j'espère que sa gardera cette mise en page quand tu l'ouvrira sinon il te suffit (sur excel 2007) d'aller dans l'onglet affichage > dans la partie fenêtre tu as 3 choix pour figer les volets, dans ton cas je pense que le premier est le plus adapter, tu te positionne en "B2" et tu choisi "figer les volets". Si tu n'as pas excel 2007 je pense que tu dois pouvoir retrouver cette fonctionnalité dans les paramètre d'affichage.

Si cette mise en page te convient il te suffira de créer une macro qui scroll vers le bas d'une vingtaine de ligne jusqu'a ce que toutes tes lignes soit parcourues et idem pour les colonnes.

Voir 40 message(s) de cette discussion en une page