J'ai un document Excel compos=E9 d'environ 8000 lignes
Ce document repr=E9sente le m=E9tr=E9 d'un ensemble immobilier.
Cet ensemble immobilier est compos=E9 de 8 b=E2timents
le batiment A occupe =E0 peu pr=E8s les 1000 1=E8res lignes
le B les 1000 suivantes..... ainsi de suite
bien s=FBr le nombre de lignes, ainsi que la hauteur de chaque ligne
varie pour chaque b=E2timent.
Ce document n'est pas fig=E9, et il et ammen=E9 =E0 =EAtre modifi=E9 souven=
t.
Au d=E9but du m=E9tr=E9 de chaque batiment, ne ligne sp=E9ciale indique le
titre.
Ce que voudrais c'est qu'=E0 l'impression du document, le nom du
batiment concern=E9 apparaisse en haut de chaque page.
j'ai essay=E9 de d=E9finir plusieurs lignes de titre, mais cela ne
fonctionne pas car les lignes de titres doivent =EAtre adgacentes.
Vous pourriez me conseiller d'ins=E9rer avant chaque page mon titre,
mais cela coupe le dynamisme du doc, et obligerait =E0 refaire la manip
apr=E8s chaque modification.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
utiliser les filtres et gestionnaire de vues (voir l'aide )
MichD
Essaie ceci :
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE" des bâtiments et le nom de la feuille où sont les données.
'--------------------------------------------------- Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T() Dim X As Integer, Sh As Worksheet, DerLig As Long Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _ "Bâtiment5", "Bâtiment6", "Bâtiment7", "Bâtiment8")
'Nom Feuille à adapter Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh DerCol = .Cells.Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column S = 1: X = 1 For A = 1 To UBound(Arr) With .Cells Set Rg = .Find(What:=Arr(A), LookIn:=xlValues, _ lookat:=xlWhole)
If Not Rg Is Nothing Then ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ Sh.Cells(Rg.Row - 1, DerCol)).Address S = S + 1 X = Rg.Row If S = UBound(Arr) + 1 Then DerLig = Sh.Cells.Find(What:="*", _ LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ .Cells(DerLig, DerCol)).Address End If End If End With Next End With
A = 0 For Each Elt In T With Sh 'Tu peux ajouter d'autres propriétés si besoin... .PageSetup.PrintArea = Elt .PageSetup.Order = xlOverThenDown .PageSetup.CenterHeader = Arr(A) .PrintPreview 'Après test, remplace par .PrintOut .PageSetup.PrintArea = "" End With A = A + 1 Next
End Sub '---------------------------------------------------
MichD ------------------------------------------ "Fredo(67)" a écrit dans le message de groupe de discussion :
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Essaie ceci :
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE"
des bâtiments et le nom de la feuille où sont les données.
'---------------------------------------------------
Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T()
Dim X As Integer, Sh As Worksheet, DerLig As Long
Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter
Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _
"Bâtiment5", "Bâtiment6", "Bâtiment7", "Bâtiment8")
'Nom Feuille à adapter
Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
S = 1: X = 1
For A = 1 To UBound(Arr)
With .Cells
Set Rg = .Find(What:=Arr(A), LookIn:=xlValues, _
lookat:=xlWhole)
If Not Rg Is Nothing Then
ReDim Preserve T(1 To S)
T(S) = Sh.Range(Sh.Cells(X, "A"), _
Sh.Cells(Rg.Row - 1, DerCol)).Address
S = S + 1
X = Rg.Row
If S = UBound(Arr) + 1 Then
DerLig = Sh.Cells.Find(What:="*", _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
ReDim Preserve T(1 To S)
T(S) = Sh.Range(Sh.Cells(X, "A"), _
.Cells(DerLig, DerCol)).Address
End If
End If
End With
Next
End With
A = 0
For Each Elt In T
With Sh
'Tu peux ajouter d'autres propriétés si besoin...
.PageSetup.PrintArea = Elt
.PageSetup.Order = xlOverThenDown
.PageSetup.CenterHeader = Arr(A)
.PrintPreview 'Après test, remplace par .PrintOut
.PageSetup.PrintArea = ""
End With
A = A + 1
Next
End Sub
'---------------------------------------------------
MichD
------------------------------------------
"Fredo(67)" a écrit dans le message de groupe de discussion :
e15bbcdb-9baf-4f96-a741-f210d74790b7@k6g2000vbz.googlegroups.com...
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux
malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE" des bâtiments et le nom de la feuille où sont les données.
'--------------------------------------------------- Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T() Dim X As Integer, Sh As Worksheet, DerLig As Long Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _ "Bâtiment5", "Bâtiment6", "Bâtiment7", "Bâtiment8")
'Nom Feuille à adapter Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh DerCol = .Cells.Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Column S = 1: X = 1 For A = 1 To UBound(Arr) With .Cells Set Rg = .Find(What:=Arr(A), LookIn:=xlValues, _ lookat:=xlWhole)
If Not Rg Is Nothing Then ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ Sh.Cells(Rg.Row - 1, DerCol)).Address S = S + 1 X = Rg.Row If S = UBound(Arr) + 1 Then DerLig = Sh.Cells.Find(What:="*", _ LookIn:=xlValues, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ .Cells(DerLig, DerCol)).Address End If End If End With Next End With
A = 0 For Each Elt In T With Sh 'Tu peux ajouter d'autres propriétés si besoin... .PageSetup.PrintArea = Elt .PageSetup.Order = xlOverThenDown .PageSetup.CenterHeader = Arr(A) .PrintPreview 'Après test, remplace par .PrintOut .PageSetup.PrintArea = "" End With A = A + 1 Next
End Sub '---------------------------------------------------
MichD ------------------------------------------ "Fredo(67)" a écrit dans le message de groupe de discussion :
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Fredo(67)
Merci beaucoup,
je vais tester ça.
On 29 fév, 04:49, "MichD" wrote:
Essaie ceci :
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE" des bâtiments et le nom de la feuille où sont les données.
'--------------------------------------------------- Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T() Dim X As Integer, Sh As Worksheet, DerLig As Long Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _ "Bâtiment5", "Bâtiment6", "Bâtiment7", "B âtiment8")
'Nom Feuille à adapter Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh DerCol = .Cells.Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Co lumn S = 1: X = 1 For A = 1 To UBound(Arr) With .Cells Set Rg = .Find(What:=Arr(A), LookIn:=xlValu es, _ lookat:=xlWhole)
If Not Rg Is Nothing Then ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ Sh.Cells(Rg.Row - 1, DerCol)).Add ress S = S + 1 X = Rg.Row If S = UBound(Arr) + 1 Then DerLig = Sh.Cells.Find(What:= "*", _ LookIn:=xlValue s, _ SearchOrder:=xl ByRows, _ SearchDirection: =xlPrevious).Row ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A" ), _ .Cells(DerLig, De rCol)).Address End If End If End With Next End With
A = 0 For Each Elt In T With Sh 'Tu peux ajouter d'autres propriétés si besoin... .PageSetup.PrintArea = Elt .PageSetup.Order = xlOverThenDown .PageSetup.CenterHeader = Arr(A) .PrintPreview 'Après test, remplace par .PrintOut .PageSetup.PrintArea = "" End With A = A + 1 Next
End Sub '---------------------------------------------------
MichD ------------------------------------------ "Fredo(67)" a écrit dans le message de groupe de discussion :
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Merci beaucoup,
je vais tester ça.
On 29 fév, 04:49, "MichD" <michde...@hotmail.com> wrote:
Essaie ceci :
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE"
des bâtiments et le nom de la feuille où sont les données.
'---------------------------------------------------
Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T()
Dim X As Integer, Sh As Worksheet, DerLig As Long
Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter
Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _
"Bâtiment5", "Bâtiment6", "Bâtiment7", "B âtiment8")
'Nom Feuille à adapter
Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh
DerCol = .Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Co lumn
S = 1: X = 1
For A = 1 To UBound(Arr)
With .Cells
Set Rg = .Find(What:=Arr(A), LookIn:=xlValu es, _
lookat:=xlWhole)
If Not Rg Is Nothing Then
ReDim Preserve T(1 To S)
T(S) = Sh.Range(Sh.Cells(X, "A"), _
Sh.Cells(Rg.Row - 1, DerCol)).Add ress
S = S + 1
X = Rg.Row
If S = UBound(Arr) + 1 Then
DerLig = Sh.Cells.Find(What:= "*", _
LookIn:=xlValue s, _
SearchOrder:=xl ByRows, _
SearchDirection: =xlPrevious).Row
ReDim Preserve T(1 To S)
T(S) = Sh.Range(Sh.Cells(X, "A" ), _
.Cells(DerLig, De rCol)).Address
End If
End If
End With
Next
End With
A = 0
For Each Elt In T
With Sh
'Tu peux ajouter d'autres propriétés si besoin...
.PageSetup.PrintArea = Elt
.PageSetup.Order = xlOverThenDown
.PageSetup.CenterHeader = Arr(A)
.PrintPreview 'Après test, remplace par .PrintOut
.PageSetup.PrintArea = ""
End With
A = A + 1
Next
End Sub
'---------------------------------------------------
MichD
------------------------------------------
"Fredo(67)" a écrit dans le message de groupe de discussion :
e15bbcdb-9baf-4f96-a741-f210d7479...@k6g2000vbz.googlegroups.com...
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux
malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Dans la procédure, il y a quelques variables à modifier comme le nom "UNIQUE" des bâtiments et le nom de la feuille où sont les données.
'--------------------------------------------------- Sub test()
Dim Arr(), DerCol As Integer, Rg As Range, T() Dim X As Integer, Sh As Worksheet, DerLig As Long Dim A As Integer, Elt As Variant, S As Integer
'Liste des noms des bâtiments à adapter Arr = Array("Bâtiment1", "Bâtiment2", "Bâtiment3", "Bâtiment4", _ "Bâtiment5", "Bâtiment6", "Bâtiment7", "B âtiment8")
'Nom Feuille à adapter Set Sh = ThisWorkbook.Worksheets("Feuil1")
With Sh DerCol = .Cells.Find(What:="*", _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious).Co lumn S = 1: X = 1 For A = 1 To UBound(Arr) With .Cells Set Rg = .Find(What:=Arr(A), LookIn:=xlValu es, _ lookat:=xlWhole)
If Not Rg Is Nothing Then ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A"), _ Sh.Cells(Rg.Row - 1, DerCol)).Add ress S = S + 1 X = Rg.Row If S = UBound(Arr) + 1 Then DerLig = Sh.Cells.Find(What:= "*", _ LookIn:=xlValue s, _ SearchOrder:=xl ByRows, _ SearchDirection: =xlPrevious).Row ReDim Preserve T(1 To S) T(S) = Sh.Range(Sh.Cells(X, "A" ), _ .Cells(DerLig, De rCol)).Address End If End If End With Next End With
A = 0 For Each Elt In T With Sh 'Tu peux ajouter d'autres propriétés si besoin... .PageSetup.PrintArea = Elt .PageSetup.Order = xlOverThenDown .PageSetup.CenterHeader = Arr(A) .PrintPreview 'Après test, remplace par .PrintOut .PageSetup.PrintArea = "" End With A = A + 1 Next
End Sub '---------------------------------------------------
MichD ------------------------------------------ "Fredo(67)" a écrit dans le message de groupe de discussion :
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
LSteph
Bonjour,
Absolument pas .. >éclater en plusieurs feuilles.
Le principe de "titres à répèter" ou définition d'un nom: Impression_des_titres
te permet de répéter le titre< sur chaque page d'impression et n'éclate en rien le document lui même.
Cordialement
-- LSteph
"Fredo(67)" a écrit dans le message de news: Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
Bonjour,
Absolument pas .. >éclater en plusieurs feuilles.
Le principe de "titres à répèter" ou définition d'un nom:
Impression_des_titres
te permet de répéter le titre< sur chaque page d'impression et n'éclate en
rien le document lui même.
Cordialement
--
LSteph
"Fredo(67)" <frederic.seys@socara.net> a écrit dans le message de
news:e15bbcdb-9baf-4f96-a741-f210d74790b7@k6g2000vbz.googlegroups.com...
Opps désolé pour les multi message, ma session avait expiré.
Oui, Michdenis, ce serait une bonne solution, mais je ne peux
malheureusement pas éclater en plusieurs feuilles.
j'ai l'obligation de tout concerver sur une seule feuille.
