Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Entête et pied de page en vba

Entête et pied de page en vba

19 réponses
Avatar
jacques
Bonjour,

Actuellement j=92utilise ce code pour un fichier Excel.

Je voudrais le compl=E9ter pour ins=E9rer :
1) Un Ent=EAte et un pied de page
2) Un saut de page apr=E8s x lignes d=92afficher sur la page.

'Existance d'un fichier mod=E8le
If Arg_Path & "" =3D "" Then
'Pas de fichier model
Set ExcelApp =3D
CreateObject("Excel.application").Workbooks.Add
Set ExcelSheet =3D ExcelApp.Worksheets(1)
Else
'Fichier mod=E8le
Set ExcelApp =3D GetObject(Arg_Path)
Set ExcelSheet =3D ExcelApp.Worksheets(1)
End If
ExcelApp.Windows(1).Visible =3D True

'Existance des donn=E9es
If Not (Arg_Rs.BOF =3D True And Arg_Rs.EOF =3D True) Then
'Il y a des donn=E9es =E0 exporter
Arg_Rs.MoveLast
Arg_Rs.MoveFirst
NbrChamps =3D Arg_Rs.Fields.Count

'Titre de colonne
For I =3D 0 To NbrChamps - 1
ExcelSheet.Cells(Arg_Ligne, I + Arg_Colonne) =3D
Arg_Rs(I).Name
Next

'Copie des infos
ExcelSheet.Cells(Arg_Ligne + 1, Arg_Colonne).CopyFromRecordset
Arg_Rs
'Mise en forme si arg_cadre =3D true
If Arg_MEF =3D True Then
'datage
With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne
- 2, Arg_Colonne), ExcelSheet.Cells(Arg_Ligne - 2, Arg_Colonne +
NbrChamps - 1))
.Font.Italic =3D True
.Font.Bold =3D True
.Font.Color =3D 255
End With
'Cadre + couleur des titres
'With =3D la zone tableau
With
ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne, Arg_Colonne),
ExcelSheet.Cells(Arg_Ligne + Arg_Rs.RecordCount, Arg_Colonne +
NbrChamps - 1))
.Borders(xlInsideVertical).Weight =3D xlThin
.Borders(xlInsideHorizontal).Weight =3D
xlThin
.Borders(xlEdgeLeft).Weight =3D xlMedium
.Borders(xlEdgeTop).Weight =3D xlMedium
.Borders(xlEdgeBottom).Weight =3D xlMedium
.Borders(xlEdgeRight).Weight =3D xlMedium

End With

With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne,
Arg_Colonne), ExcelSheet.Cells(Arg_Ligne, Arg_Colonne + NbrChamps -
1))
.Interior.ColorIndex =3D 37
.Borders(xlEdgeBottom).Weight =3D xlMedium
End With
End If
End If

Merci pour votre aide

Salutations
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Joe H
1/ L'essentiel, avec x = 10:

Sub MiseEnForme()
Dim x As Integer
Dim i As Integer
Dim c As Integer
Dim d As Integer

Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.LeftHeader = "Partie gauche En-tête"
.CenterHeader = "Partie centrale En-tête"
.RightHeader = "Partie droite En-tête"
.LeftFooter = "Partie gauche Pied de page" & Chr(10) & "&F &A"
.CenterFooter = "Partie centrale Pied de page" & Chr(10) & "&P/
&N"
.RightFooter = "Partie droite Pied de page" & Chr(10) & "&D
&T"
End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

x = 10
c = ActiveSheet.UsedRange.Row
d = Cells.SpecialCells(xlLastCell).Row

For i = 1 To Round((d - c) / x, 0)
ActiveWindow.SelectedSheets.HPageBreaks.Add
Before:Îlls(c + i * x, 1)
Next

Application.ScreenUpdating = True

End Sub

--------------------------------------

2/ Avec d'autres paramètres d'impression pré-définis:

Sub MiseEnForme()
Dim x As Integer
Dim i As Integer
Dim c As Integer
Dim d As Integer

Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
With ActiveSheet.PageSetup
.LeftHeader = "Partie gauche En-tête"
.CenterHeader = "Partie centrale En-tête"
.RightHeader = "Partie droite En-tête"
.LeftFooter = "Partie gauche Pied de page" & Chr(10) & "&F &A"
.CenterFooter = "Partie centrale Pied de page" & Chr(10) & "&P/
&N"
.RightFooter = "Partie droite Pied de page" & Chr(10) & "&D
&T"
.LeftMargin = Application.InchesToPoints(1)
.RightMargin = Application.InchesToPoints(1)
.TopMargin = Application.InchesToPoints(0.9)
.BottomMargin = Application.InchesToPoints(0.9)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 1
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With

ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

x = 10
c = ActiveSheet.UsedRange.Row
d = Cells.SpecialCells(xlLastCell).Row

For i = 1 To Round((d - c) / x, 0)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:Îlls(c +
i * x, 1)
Next

Application.ScreenUpdating = True

End Sub
Avatar
isabelle
bonjour Jacques,

x = 10
With ExcelSheet
With .PageSetup
.CenterHeader = "Tête"
.CenterFooter = "Pied"
End With
.HPageBreaks.Add Before:=Rows(x)
End With

isabelle


Le 2010-12-06 07:49, jacques a écrit :
Bonjour,

Actuellement j’utilise ce code pour un fichier Excel.

Je voudrais le compléter pour insérer :
1) Un Entête et un pied de page
2) Un saut de page après x lignes d’afficher sur la page.

'Existance d'un fichier modèle
If Arg_Path& "" = "" Then
'Pas de fichier model
Set ExcelApp > CreateObject("Excel.application").Workbooks.Add
Set ExcelSheet = ExcelApp.Worksheets(1)
Else
'Fichier modèle
Set ExcelApp = GetObject(Arg_Path)
Set ExcelSheet = ExcelApp.Worksheets(1)
End If
ExcelApp.Windows(1).Visible = True

'Existance des données
If Not (Arg_Rs.BOF = True And Arg_Rs.EOF = True) Then
'Il y a des données à exporter
Arg_Rs.MoveLast
Arg_Rs.MoveFirst
NbrChamps = Arg_Rs.Fields.Count

'Titre de colonne
For I = 0 To NbrChamps - 1
ExcelSheet.Cells(Arg_Ligne, I + Arg_Colonne) > Arg_Rs(I).Name
Next

'Copie des infos
ExcelSheet.Cells(Arg_Ligne + 1, Arg_Colonne).CopyFromRecordset
Arg_Rs
'Mise en forme si arg_cadre = true
If Arg_MEF = True Then
'datage
With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne
- 2, Arg_Colonne), ExcelSheet.Cells(Arg_Ligne - 2, Arg_Colonne +
NbrChamps - 1))
.Font.Italic = True
.Font.Bold = True
.Font.Color = 255
End With
'Cadre + couleur des titres
'With = la zone tableau
With
ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne, Arg_Colonne),
ExcelSheet.Cells(Arg_Ligne + Arg_Rs.RecordCount, Arg_Colonne +
NbrChamps - 1))
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight > xlThin
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium

End With

With ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne,
Arg_Colonne), ExcelSheet.Cells(Arg_Ligne, Arg_Colonne + NbrChamps -
1))
.Interior.ColorIndex = 37
.Borders(xlEdgeBottom).Weight = xlMedium
End With
End If
End If

Merci pour votre aide

Salutations
Avatar
jacques
On 7 déc, 00:24, isabelle wrote:
bonjour Jacques,

x = 10
With ExcelSheet
    With .PageSetup
     .CenterHeader = "T te"
     .CenterFooter = "Pied"
    End With
     .HPageBreaks.Add Before:=Rows(x)
End With

isabelle

Le 2010-12-06 07:49, jacques a crit :



> Bonjour,

> Actuellement j utilise ce code pour un fichier Excel.

> Je voudrais le compl ter pour ins rer :
> 1) Un Ent te et un pied de page
> 2) Un saut de page apr s x lignes d afficher sur la page.

> 'Existance d'un fichier mod le
>      If Arg_Path&  "" = "" Then
>          'Pas de fichier model
>              Set ExcelApp =
> CreateObject("Excel.application").Workbooks.Add
>              Set ExcelSheet = ExcelApp.Worksheets(1)
>      Else
>          'Fichier mod le
>              Set ExcelApp = GetObject(Arg_Path)
>              Set ExcelSheet = ExcelApp.Worksheets(1)
>      End If
>      ExcelApp.Windows(1).Visible = True

> 'Existance des donn es
> If Not (Arg_Rs.BOF = True And Arg_Rs.EOF = True) Then
>      'Il y a des donn es exporter
>          Arg_Rs.MoveLast
>          Arg_Rs.MoveFirst
>          NbrChamps = Arg_Rs.Fields.Count

>        'Titre de colonne
>          For I = 0 To NbrChamps - 1
>              ExcelSheet.Cells(Arg_Ligne, I + Arg_Colonne) =
> Arg_Rs(I).Name
>          Next

>        'Copie des infos
>          ExcelSheet.Cells(Arg_Ligne + 1, Arg_Colonne).CopyFro mRecordset
> Arg_Rs
>          'Mise en forme si arg_cadre = true
>              If Arg_MEF = True Then
>                  'datage
>                       With ExcelSheet.Range(Excel Sheet.Cells(Arg_Ligne
> - 2, Arg_Colonne), ExcelSheet.Cells(Arg_Ligne - 2, Arg_Colonne +
> NbrChamps - 1))
>                          .Font.Italic = Tru e
>                          .Font.Bold = True
>                          .Font.Color = 255
>                      End With
>                  'Cadre + couleur des titres
>                      'With = la zone tableau
>                          With
> ExcelSheet.Range(ExcelSheet.Cells(Arg_Ligne, Arg_Colonne),
> ExcelSheet.Cells(Arg_Ligne + Arg_Rs.RecordCount, Arg_Colonne +
> NbrChamps - 1))
>                              .Borders(xlI nsideVertical).Weight = xlThin
>                              .Borders(xlI nsideHorizontal).Weight =
> xlThin
>                              .Borders(xlE dgeLeft).Weight = xlMedium
>                              .Borders(xlE dgeTop).Weight = xlMedium
>                              .Borders(xlE dgeBottom).Weight = xlMedium
>                              .Borders(xlE dgeRight).Weight = xlMedium

>                          End With

>                      With ExcelSheet.Range(ExcelS heet.Cells(Arg_Ligne,
> Arg_Colonne), ExcelSheet.Cells(Arg_Ligne, Arg_Colonne + NbrChamps -
> 1))
>                          .Interior.ColorIndex = 37
>                          .Borders(xlEdgeBotto m).Weight = xlMedium
>                      End With
>              End If
> End If

> Merci pour votre aide

> Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonsoir Isabelle, Bonsoir Joe H,

Merci pour vos réponses.

En premier j'essaye la solution d'Isabelle.

Lorsque je lance le code j'ai une erreur (sub ou fonction non définie)
sur Rows.

A+

Salutations
Avatar
isabelle
bonjour Jacques,

il doit y avoir un point devant Rows,

.HPageBreaks.Add Before:=.Rows(x)

isabelle



Le 2010-12-08 11:57, jacques a écrit :
On 7 déc, 00:24, isabelle wrote:
bonjour Jacques,

x = 10
With ExcelSheet
With .PageSetup
.CenterHeader = "T te"
.CenterFooter = "Pied"
End With
.HPageBreaks.Add Before:=Rows(x)
End With

isabelle

Le 2010-12-06 07:49, jacques a crit :



Bonsoir Isabelle, Bonsoir Joe H,

Merci pour vos réponses.

En premier j'essaye la solution d'Isabelle.

Lorsque je lance le code j'ai une erreur (sub ou fonction non définie)
sur Rows.

A+

Salutations
Avatar
jacques
On 9 déc, 00:32, isabelle wrote:
bonjour Jacques,

il doit y avoir un point devant Rows,

.HPageBreaks.Add Before:=.Rows(x)

isabelle

Le 2010-12-08 11:57, jacques a crit :



> On 7 d c, 00:24, isabelle  wrote:
>> bonjour Jacques,

>> x = 10
>> With ExcelSheet
>>      With .PageSetup
>>       .CenterHeader = "T te"
>>       .CenterFooter = "Pied"
>>      End With
>>       .HPageBreaks.Add Before:=Rows(x)
>> End With

>> isabelle

>> Le 2010-12-06 07:49, jacques a crit :
> Bonsoir Isabelle, Bonsoir Joe H,

> Merci pour vos r ponses.

> En premier j'essaye la solution d'Isabelle.

> Lorsque je lance le code j'ai une erreur (sub ou fonction non d finie)
> sur Rows.

> A+

> Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonsoir Isabelle,

Ca marche, c'était bien le point qui manquait.

Maintenant je voudrais inserer des lignes après chaque saut de page.

Peux-tu m'aider ?

A+

Salutations
Avatar
isabelle
bonjour Jacques,

par exemple pour insérer 2 lignes à chaque saut de page

For Each hpb In ActiveSheet.HPageBreaks
x = hpb.Location.Row
Rows(x & ":" & x + 1).Insert Shift:=xlDown
Next


isabelle

.


Le 2010-12-09 14:13, jacques a écrit :

Bonsoir Isabelle,

Ca marche, c'était bien le point qui manquait.

Maintenant je voudrais inserer des lignes après chaque saut de page.

Peux-tu m'aider ?

A+

Salutations
Avatar
jacques
On 9 déc, 20:32, isabelle wrote:
bonjour Jacques,

par exemple pour ins rer 2 lignes chaque saut de page

For Each hpb In ActiveSheet.HPageBreaks
x = hpb.Location.Row
Rows(x & ":" & x + 1).Insert Shift:=xlDown
Next

isabelle

.

Le 2010-12-09 14:13, jacques a crit :



> Bonsoir Isabelle,

> Ca marche, c' tait bien le point qui manquait.

> Maintenant je voudrais inserer des lignes apr s chaque saut de page.

> Peux-tu m'aider ?

> A+

> Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Re Bonsoir Isabelle,

La le code bloque sur xlDown, et je ne comprend pas pourquoi.

Salutations
Avatar
isabelle
bonjour Jacques,

voici un fichier exemple :
http://cjoint.com/?0mkbNuBEmCu

isabelle

.

Le 2010-12-09 19:14, jacques a écrit :

Bonsoir Isabelle,



Ca marche, c' tait bien le point qui manquait.



Maintenant je voudrais inserer des lignes apr s chaque saut de page.



Peux-tu m'aider ?



A+



Salutations- Masquer le texte des messages précédents -



- Afficher le texte des messages précédents -



Re Bonsoir Isabelle,

La le code bloque sur xlDown, et je ne comprend pas pourquoi.

Salutations

Avatar
jacques
On 10 déc, 01:40, isabelle wrote:
bonjour Jacques,

voici un fichier exemple :http://cjoint.com/?0mkbNuBEmCu

isabelle

.

Le 2010-12-09 19:14, jacques a crit :



>>> Bonsoir Isabelle,

>>> Ca marche, c' tait bien le point qui manquait.

>>> Maintenant je voudrais inserer des lignes apr s chaque saut de page.

>>> Peux-tu m'aider ?

>>> A+

>>> Salutations- Masquer le texte des messages pr c dents -

>> - Afficher le texte des messages pr c dents -

> Re Bonsoir Isabelle,

> La le code bloque sur xlDown, et je ne comprend pas pourquoi.

> Salutations- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -



Bonjour Isabelle,

Super le fichier exemple.

Peux-tu le compléter en ajoutant pour chaque page et sur deux lignes
un Entête de page et un pied de page?.

De plus est-il possible d'avoir sur l'entête de page les noms (Ex NOM,
PRENOM, ADRESSE etc...;)
des colonnes formatées (Ex Largeur police centrer etc...;)?.

Je te remercie par avance.

A+

Salutations
Avatar
isabelle
bonjour Jacques,

pour l'entête et pied de page sur 2 lignes,

With ActiveSheet.PageSetup
.CenterHeader = "tete" & Chr(10) & "deuxième ligne"
.CenterFooter = "pied" & Chr(10) & "deuxième ligne"
End With

pour l'autre question je ne comprend pas ce que tu veut dire.

isabelle



Le 2010-12-10 04:19, jacques a écrit :
On 10 déc, 01:40, isabelle wrote:
bonjour Jacques,

voici un fichier exemple :http://cjoint.com/?0mkbNuBEmCu

isabelle

.

Le 2010-12-09 19:14, jacques a crit :



Bonsoir Isabelle,







Ca marche, c' tait bien le point qui manquait.







Maintenant je voudrais inserer des lignes apr s chaque saut de page.







Peux-tu m'aider ?







A+







Salutations- Masquer le texte des messages pr c dents -







- Afficher le texte des messages pr c dents -





Re Bonsoir Isabelle,



La le code bloque sur xlDown, et je ne comprend pas pourquoi.



Salutations- Masquer le texte des messages précédents -



- Afficher le texte des messages précédents -



Bonjour Isabelle,

Super le fichier exemple.

Peux-tu le compléter en ajoutant pour chaque page et sur deux lignes
un Entête de page et un pied de page?.

De plus est-il possible d'avoir sur l'entête de page les noms (Ex NOM,
PRENOM, ADRESSE etc...;)
des colonnes formatées (Ex Largeur police centrer etc...;)?.

Je te remercie par avance.

A+

Salutations

1 2