Discussion :

[Invité]

Est-ce possible de vérifier si un texte avec une police spéciale est en fin de page si non faire des sauts de lignes sur la page pour qu'il soit en fin de page ?

Si vous parlez du pied de page, il vous faut tester la présence du pied de page pour la section en cours, et le cas échéant chercher la chaîne avec Instr et vérifier le style.

Ajouter du texte à une entête ? (j'aimerai agrandir mon entête en y ajoutant les noms des colonnes ?

Il y a des exemples sur ce forum pour gérer des tableaux dans un entête.

[tetetete]

Bonjour,
désolé de te déranger encore
Cependant, j'ai un problème à propros de la macro que tu as réalisé.
Quelques fois l'astérix de début ou celle de fin n'est pas pris en compte, j'ai essayé de regarder ton compte mais il y a des parties vraiment trop dur pour moi.
Je te transmet un fichier word exemple pour que tu puisses le voir.
Cordialement,
tetetete

[Invité]

Bonjour,

Pas sur que tous les cas soit traités :

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
 
Option Explicit
 
Public DocEnCours As Document
 
Sub RechercheEntreEtoilesV3()
 
 
Dim I As Long, CaractereEnCours As Long
Dim MonRange As Range
Dim IndexSignet As Integer
 
   On Error GoTo Fin
 
  ' Application.ScreenUpdating = False
 
   Set DocEnCours = Documents("exemple (3).docx") 'ActiveDocument
  ' Set DocEnCours = ActiveDocument
 
   With DocEnCours
 
        For I = .Bookmarks.Count To 1 Step -1
            .Bookmarks(I).Delete
        Next I
        IndexSignet = 1
 
        .Range.HighlightColorIndex = wdAuto
 
        For I = 1 To .Paragraphs.Count
            .Paragraphs(I).Range.Select
            If InStr(1, .Paragraphs(I).Range.Text, "*", vbTextCompare) > 0 Then
              .Paragraphs(I).Range.Select
              With Selection
                   If IndexSignet < 10 Then
                      .Bookmarks.Add Name:="Signet0" & IndexSignet
                   Else
                      .Bookmarks.Add Name:="Signet" & IndexSignet
                   End If
                   IndexSignet = IndexSignet + 1
              End With
            End If
        Next I
 
        If IndexSignet > 0 Then
           For I = 1 To .Bookmarks.Count
               EssaiSignet DocEnCours, .Bookmarks(I)
           Next I
        End If
 
   End With
 
   GoTo Fin
 
Fin:
 
   Set MonRange = Nothing
   Set DocEnCours = Nothing
 
  '  Application.ScreenUpdating = True
 
End Sub
 
 
 
Sub EssaiSignet(ByVal DocEnCours2 As Document, ByVal MonSignet2 As Bookmark)
 
Dim MonRange1 As Range, MonRange2 As Range
Dim J As Long, Pos1 As Long, Pos2 As Long
Dim MesCaracteres As String
Dim MesPositions As Variant
 
   With DocEnCours2
 
        With MonSignet2
             Pos1 = .Range.Start
             Pos2 = .Range.End
        End With
 
        Set MonRange1 = .Range(Start:=Pos1, End:=Pos2)
 
        MesCaracteres = ""
        For J = 1 To Len(MonRange1.Text)
            If Mid(MonRange1.Text, J, 1) = "*" Then
               MesCaracteres = MesCaracteres & J & "-"
            End If
        Next J
 
        If Len(MesCaracteres) > 0 Then
 
           MesCaracteres = Mid(MesCaracteres, 1, Len(MesCaracteres) - 1)
           MesPositions = Split(MesCaracteres, "-")
           For J = LBound(MesPositions) To UBound(MesPositions)
 
             Select Case J
                    Case 0
                       If Pos1 + MesPositions(J) - 1 = Pos1 Then
                          Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1))
                          If Mid(MonRange2.Text, Len(MonRange2.Text), 1) <> "*" Then
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1) + 1)
                             Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
                          End If
 
                          With MonRange2
                               .HighlightColorIndex = wdYellow
                          End With
                        '  Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
                          Set MonRange2 = Nothing
                       Else
 
                          Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J), End:=Pos1 + MesPositions(J + 1) + 1)
                          If Mid(MonRange2.Text, 1, 1) <> "*" Then
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1) + 1)
                             Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
                          End If
                          With MonRange2
                              .HighlightColorIndex = wdYellow
                          End With
                        '  Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) & ", pos2 " & Pos2 + MesPositions(J + 1) + 1
 
                          Set MonRange2 = Nothing
 
 
                       End If
 
                    Case 2, 4
                         Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 1, End:=Pos1 + MesPositions(J + 1))
                         If Mid(MonRange2.Text, 1, 1) <> "*" Then
                             Set MonRange2 = .Range(Start:=Pos1 + MesPositions(J) - 2, End:=Pos1 + MesPositions(J + 1) + 1)
                             Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
                          End If
 
                         With MonRange2
                              .HighlightColorIndex = wdYellow
                         End With
                         ' Debug.Print MonRange2 & ", pos1 " & Pos1 & " : " & Pos1 + MesPositions(J) - 1 & ", pos2 " & Pos2 + MesPositions(J + 1)
 
                         Set MonRange2 = Nothing
             End Select
            Next J
 
        End If
 
        Set MonRange1 = Nothing
 
  End With
 
End Sub

[tetetete]

Merci ça marche
Juste une dernière question pour l'entête et je te laisse tranquille
Mes noms de colonnes reviennent toutes les pages mais ne sont pas dans l'entête or j'aimerais les mettre dans l'entête. Y'aurait-il un moyen de le faire rapidement par exemple en agrandissant l'entête sachant que le copier coller ne marche pas la mise en forme n'est pas bonne et je dois tout refaire.

[Invité]

Créer une forme. Faire une capture d'écran de l'entête et la coller dans la forme. Sauvegarder l'objet en tant qu'objet Quickpart. Une fois fait, agrandir l'entête et importer l'objet Quickpart.