Comment effacer les pieds de page dans les sections en mode paysage

**srekk** · 17/03/2020, 15h54

Bonjour,

J'ai un doc word dans lequel un certain nombre de sections sont en mode paysage. Pour ces sections, que je ne connais pas à l'avance, j'essaye de tester si la mise en page est en paysage, si c'est le cas le pied de page doit être supprimé.

J'ai cherché dans le forum avec les mots clé "section", "paysage" et "mise en page" mais cela ne donne rien que je puisse exploiter.
J'ai essayé diverses choses dont celle ci-dessous.

Merci d'avance pour votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub DeleteFooterIfLandscape()
 
Dim S As Section
Dim F As HeaderFooter
 
 
Application.ScreenUpdating = False
 
    For Each S In ActiveDocument.Sections
    For Each F In S.Footers
    F.Range.Select
 
    If S.PageSetup.Orientation = 1 Then 
        F.Range.Delete
    End If
 
    Next F
    Next S
 
Application.ScreenUpdating = True
 
 
End Sub

Invité · 17/03/2020, 17h14

Envoyé par srekk

Bonjour,

Il vous faut vérifier d'abord l'existence d'un lien lors du passage d'un mode Paysage au mode Portrait et le supprimer sur le mode portrait le cas échéant, sinon vous perdez vos pieds de page sur les sections en mode portrait s'ils étaient liés.
Dans votre notation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

F.LinkToPrevious = False

**srekk** · 17/03/2020, 20h38

Envoyé par Eric KERGRESSE

Bonjour,

Il vous faut vérifier d'abord l'existence d'un lien lors du passage d'un mode Paysage au mode Portrait et le supprimer sur le mode portrait le cas échéant, sinon vous perdez vos pieds de page sur les sections en mode portrait s'ils étaient liés.
Dans votre notation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

F.LinkToPrevious = False

Bonsoir Eric,

Merci pour votre réponse, c'est déja fait ailleurs dans la macro principale que je n'ai pas mise ici.
Tous les entêtes et pieds de page sont "déliés".

Samantha

Invité · 18/03/2020, 02h37

Envoyé par srekk

Eh bien, c'est quand même là qu'est votre problème, puisque votre code appliqué sur des sections avec pieds de page liés alternant les deux modes, efface tout.

Mettez en ligne le code qui vous permet de délier les pieds de page.

**srekk** · 18/03/2020, 11h51

Envoyé par Eric KERGRESSE

Eh bien, c'est quand même là qu'est votre problème, puisque votre code appliqué sur des sections avec pieds de page liés alternant les deux modes, efface tout.

Mettez en ligne le code qui vous permet de délier les pieds de page.

Bonjour Eric,

Désolée je n'avais pas compris que vous me disiez que c'était ça le problème mais que vous m'informiez du risque potentiel...
:-)

Après quelques modifs fonction de votre première remarque ça fonctionne :-). Merci!

Probablement que le pb venait de la première macro que j'ai utilisé pour délier/effacer les Header/Footer, ci-après (je ne sais pas où est le problème) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub DeleteDelinkHeadreFooter()
 
Dim numero_section As Integer
 
numero_section = ActiveDocument.Sections.Count
 
With ActiveDocument.Sections(numero_section)
    With .Headers(wdHeaderFooterFirstPage)
        .LinkToPrevious = False
        .Range.Delete
    End With
    With .Headers(wdHeaderFooterEvenPages)
        .LinkToPrevious = False
        .Range.Delete
    End With
    With .Headers(wdHeaderFooterPrimary)
        .LinkToPrevious = False
        .Range.Delete
    End With
    With .Footers(wdHeaderFooterFirstPage)
        .LinkToPrevious = False
        .Range.Delete
    End With
    With .Footers(wdHeaderFooterEvenPages)
        .LinkToPrevious = False
        .Range.Delete
    End With
    With .Footers(wdHeaderFooterPrimary)
        .LinkToPrevious = False
        .Range.Delete
    End With
End With
End Sub

Avec votre remarque j'ai modifié mes macros de suppression de Headre/Footer comme suit (car beaucoup plus simple à mon sens):

Pour les entêtes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Sub DeleteAllHeader()
   Application.ScreenUpdating = False
 
    For Each S In ActiveDocument.Sections
    For Each H In S.Headers
    With H
        .Range.Delete
        .LinkToPrevious = False
    End With
 
    Next H
    Next S
 
    Application.ScreenUpdating = True
End Sub

Pour les pieds de page:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Public Sub DeleteAllFooter()
    Application.ScreenUpdating = False
    For Each S In ActiveDocument.Sections
    For Each F In S.Footers
 
    With F
        .Range.Delete
        .LinkToPrevious = False
    End With
 
    Next F
    Next S
 
    Application.ScreenUpdating = True
End Sub

Après je n'ai plus qu'à appliquer mes macros d'insertion d'entêtes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub HeaderCreate()
    Dim S As Section
    Dim H As HeaderFooter
 
    Application.ScreenUpdating = False
 
    Call DeleteAllHeader
 
    For Each S In ActiveDocument.Sections
    For Each H In S.Headers
 
    H.Range.Select
 
    'met en forme la police
    With Selection
       With .Font
         .Name = "Tahoma"
         .Size = 8
       End With
    End With
 
    With Selection
        'insère le titre 1 de la section avec son numéro
        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="STYLEREF  ""Titre 1"" \r ", PreserveFormatting:=True
        .TypeText Text:=".Â*"
        .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="STYLEREF  ""Titre 1"" ", PreserveFormatting:=True
        'mise en forme de paragraphe
        'insère une ligne noire sous l'entête
        With .ParagraphFormat
            With .Borders(wdBorderBottom)
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth050pt
                .Color = -587137025
            End With
            'aligne à gauche, sans indentation de première ligne
            'interligne simple, sans espace avant et 24 après
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceAfter = 24
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .FirstLineIndent = CentimetersToPoints(0)
        End With
 
    End With
    'passe au header suivant
    Next H
    'passe à la section suivante
    Next S
 
    'sort de l'entête et met en mode page
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
 
    Application.ScreenUpdating = True
 
End Sub

et de Footer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub FooterCreate()
    Dim S As Section
    Dim F As HeaderFooter
    Dim Carte
 
    Application.ScreenUpdating = False
 
    'insère le titre 1 de la section avec son numéro
    Carte = InputBox("Quelle est le numéro et le nom de la carte?")
 
    Call DeleteAllFooter
 
    For Each S In ActiveDocument.Sections
    For Each F In S.Footers
    F.Range.Select
 
 
   'met en forme la police
    With Selection
       With .Font
         .Name = "Tahoma"
         .Size = 8
       End With
   With Selection.ParagraphFormat.TabStops
        .ClearAll
        .Add Position:=CentimetersToPoints(17), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
    End With
    'insertion d'un espace de tabulation
       .TypeText Text:=Carte & vbTab
    'insertion du numéro de page
       .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="PAGE  \* Arabic ", PreserveFormatting:=True
    End With
 
    With Selection
        'mise en forme de paragraphe
        'insère une ligne noire sous l'entête
        With .ParagraphFormat
            With .Borders(wdBorderTop)
                .LineStyle = wdLineStyleSingle
                .LineWidth = wdLineWidth050pt
                .Color = -587137025
            End With
            'aligne à gauche, sans indentation de première ligne
            'interligne simple, sans espace avant et 24 après
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 24
            .SpaceAfter = 0
            .LineSpacingRule = wdLineSpaceSingle
            .Alignment = wdAlignParagraphLeft
            .FirstLineIndent = CentimetersToPoints(0)
        End With
 
    End With
    'passe au header suivant
    Next F
    'passe à la section suivante
    Next S
 
    'sort de l'entête et met en mode page
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
    'Sort de l'en-tête
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    'mode page
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
 
    Application.ScreenUpdating = True
 
End Sub

Et enfin celle de suppression des section paysages:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub DeleteFooterIfLandscape()
 
Dim S As Section
Dim F As HeaderFooter
 
Application.ScreenUpdating = False
 
    For Each S In ActiveDocument.Sections
    For Each F In S.Footers
    F.Range.Select
 
    If S.PageSetup.Orientation = 1 Then
        F.Range.Delete
    End If
 
    Next F
    Next S
 
Application.ScreenUpdating = True
End Sub

Invité · 18/03/2020, 12h16

Envoyé par srekk

Bonjour Samantha,

Pour poster du code, sélectionnez le code et cliquez sur le bouton # dans le menu. Nb : Il n'est pas trop tard en modification

, ce sera plus facile à lire.

Sinon, dans la procédure DeleteAllFooter, il faut supprimer les liens avant de supprimer le texte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Public Sub DeleteAllFooter()
    Application.ScreenUpdating = False
    For Each S In ActiveDocument.Sections
    For Each F In S.Footers
 
    With F
        .Range.Delete
        .LinkToPrevious = False
    End With
 
    Next F
    Next S
 
    Application.ScreenUpdating = True
End Sub

Ci-dessous le code que j'ai utilisé. Avec un premier balayage, je détecte les cas d'un passage d'un mode portrait en mode paysage et je supprime le lien sur le mode paysage.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub SupprimerPiedDePageModePaysage()
 
Dim I As Integer, J As Integer
Dim DocEnCours As Document
Dim OrientationEnCours As String
 
    Set DocEnCours = ActiveDocument
 
    With DocEnCours
 
         ' Suppression des liens dans le cas d'un passage du mode paysage au mode portrait
         '--------------------------------------------------------------------------------
         For I = 1 To .Sections.Count
             With .Sections(I)
                  If .PageSetup.Orientation = wdOrientLandscape Then
                     OrientationEnCours = "Paysage"
                  Else
                     If OrientationEnCours = "Paysage" Then
                        If .Footers.Count > 0 Then
                           For J = .Footers.Count To 1 Step -1
                               .Footers(J).LinkToPrevious = False
                           Next J
                         End If
                      End If
                      OrientationEnCours = "Portrait"
                  End If
 
               End With
         Next I
 
         ' Suppression des textes
         '-----------------------
         For I = .Sections.Count To 1 Step -1
             With .Sections(I)
                  If .PageSetup.Orientation = wdOrientLandscape Then
 
                      If .Footers.Count > 0 Then
                         For J = .Footers.Count To 1 Step -1
                             With .Footers(J)
                                  .LinkToPrevious = False
                                  .Range.Delete
                             End With
                         Next J
                      End If
                  End If
               End With
         Next I
    End With
 
    Set DocEnCours = Nothing
 
 
End Sub

**srekk** · 18/03/2020, 12h56

Eric,

Merci pour la boucle.

Il est vrai que par facilité (et incompétence ahahah) j'ai "délinké" toutes les sections peu importe les formats portrait/paysage.

Merci pour l'aide!

Bonne journée,

Je retourne télétravailler de chez moi because Covid19...

Comment effacer les pieds de page dans les sections en mode paysage [WD-365]

VBA Word

Discussions similaires

Partager

Partager