Discussion :

[srekk]

Bonjour,

Mon problème était le suivant, j'ai de nombreux documents dans lesquels les auteurs, plutôt que d'utiliser les sauts de section ou saut de page, ou propriétés des paragraphes, utilisent les sauts de lignes pour espacer les paragraphes ou passer à la page suivante, ce qui génère des problèmes de mise en page lors d'éventuelles modifications ultérieures.

Je dois donc revoir leurs docs et, entre autres choses, nettoyer la mise en page, soit effacer tous les sauts de ligne inutiles mais sans que les sauts de section et/ou de page ne soient effacés dans la foulée.

Après m'être arraché les cheveux, j'ai fini par produire la macro ci-dessous qui fait le boulot MAIS qui est plutôt lente et je n'aime pas trop utiliser des "goto" dans mes macros.

Ma question est : un (bon) génie de ce forum aurait-il quelques idées pour accélérer le processus?

D'avance merci,

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
Sub DeleteSautLigneVide()
'
' Efface les sauts de ligne
' sans effacer les sauts de page
' ni les saut de section
'
 
    Dim P As Paragraph
 
    Application.ScreenUpdating = False
 
    Selection.HomeKey unit:=wdStory
 
    'vérifie la longueur du paragraphe
    For Each P In ActiveDocument.Paragraphs
            'si la longueur est de 1 caractère alors
            If Len(P.Range.Text) = 1 Then
                'cherche un saut de ligne
                With P.Range.Find
                    .ClearFormatting
                    .Execute FindText:="^p"
                    's'il trouve un saut de ligne alors
                    If .Found = True Then
                        'cherche un saut de section
                        With P.Range.Find
                            .ClearFormatting
                            .Execute FindText:="^b"
                             's'il trouve un saut de section alors
                             'sort de boucle et va à 1
                             If .Found = True Then
                                GoTo 1
                             's'il ne trouve pas de saut de section alors
                             ElseIf .Found = False Then
                                'cherche un saut de page
                                With P.Range.Find
                                    .ClearFormatting
                                    .Execute FindText:="^m"
                                    's'il trouve un saut de page alors
                                    'sort de la boucle et va à 1
                                     If .Found = True Then
                                        GoTo 1
                                    's'il ne trouve pas de saut de page alors
                                    'efface le paragraphe
                                     ElseIf .Found = False Then
                                        P.Range.Delete
                                     End If
                                End With
                             End If
                        End With
                    End If
                End With
            End If
1     Next P
    Application.ScreenUpdating = True
    MsgBox "Sauts de ligne inutiles effacés chef!"
 
End Sub

[Invité]

Salut Samantha,

Je suis d'une nullité crasse, je n'arrive plus à me représenter un saut de ligne comme tu le présentes . Si tu souhaites que je regarde, peux-tu mettre un exemple en ligne avec tes différents sauts ?
Tu mets combien de temps actuellement pour un document de combien de pages.

Sans garantie.

La pensée du jour : Il n'y a pas de (bon) génie sans bouillir.

[srekk]

Salut Samantha,

Je suis d'une nullité crasse, je n'arrive plus à me représenter un saut de ligne comme tu le présentes . Si tu souhaites que je regarde, peux-tu mettre un exemple en ligne avec tes différents sauts ?
Tu mets combien de temps actuellement pour un document de combien de pages.

exemple.docx


Merci pour ta réaction Eric,

En attach un exemple avec plusieurs sauts de ligne vide [^p ou chr(10)], un saut de section (^b) et un saut de page [^m ou chr(12)]
Il faut faire apparaître les caractères masqués pour les voir (ctrl+8 d'après la touche de raccourcis de mon word).

Il met 18sec pour 1543 paragraphes (environs 100 pages avec des illustrations).

La plupart des solutions en ligne pour effacer les sauts de ligne vide, présentent une macro où il s'agit de passer en revue tous les paragraphes et s'ils ne font qu'un caractère de les effacer.
Le problème c'est que juste sous cette forme, cela efface aussi les sauts de page et les sauts de section.
J'ai donc rajouté du code à ce type de macro pour qu'elle teste la présence d'un saut de page ou de section et les "saute" en cas de présence avérée.
Mais, comme je l'ai dit, 18 sec c'est long... de façon relative bien sure...
;-)

Bonne journée

Samantha

[Invité]

Peux-tu tester ce code qui fait l'inventaire des caractères spéciaux de fin de paragraphe ou de section avant et après application de ton code. Ce code ne supprime rien.

Le traitement sur ton fichier donne ce résultat :

Avant traitement :

Pièce jointe 549430


Après traitement :

Pièce jointe 549431

On voit qu'il faut garder les cas Nb car > 1, les cas Chr(13) et Chr(12) et supprimer les cas NBcar = 1 et Chr(13). Le dernier paragraphe est forcément Chr(13).

Question : En supposant que le temps de traitement pour détruire les cas NBcar = 1 et Chr(13) soit très réduit puisqu'on a identifié les paragraphes concernés et que le traitement se fait dans l'ordre inverse des paragraphes, quelle est la durée de ce traitement sur ton fichier de 1543 paragraphes ?

Peux-tu me dire s'il y a d'autres cas dans les tableaux résultants avant aprè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
 
 
Sub DeleteSautLigneVide2()
 
Dim HeureDebut2, HeureFin2, TempsTotal2
Dim DocEnCours As Document
Dim I As Long, IndexP As Long
Dim PositionChaine As Integer
Dim MatriceSauts() As Variant
 
    HeureDebut2 = Timer    ' Définit l'heure de début.
 
    Application.ScreenUpdating = False
 
    Set DocEnCours = Documents("exemple (1).docx")
 
    With DocEnCours
 
         Selection.HomeKey unit:=wdStory
 
    'vérifie la longueur du paragraphe
    IndexP = 0
    For I = .Paragraphs.Count To 1 Step -1
        With .Paragraphs(I).Range
             If InStr(1, .Text, Chr(13), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(12), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(11), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(10), vbTextCompare) > 0 Then
 
               ReDim Preserve MatriceSauts(5, IndexP)
               MatriceSauts(0, IndexP) = I
               MatriceSauts(1, IndexP) = Len(.Text)
               MatriceSauts(2, IndexP) = InStr(1, .Text, Chr(13), vbTextCompare)
               MatriceSauts(3, IndexP) = InStr(1, .Text, Chr(12), vbTextCompare)
               MatriceSauts(4, IndexP) = InStr(1, .Text, Chr(11), vbTextCompare)
               MatriceSauts(5, IndexP) = InStr(1, .Text, Chr(10), vbTextCompare)
               IndexP = IndexP + 1
 
             End If
        End With
 
     Next I
 
    End With
 
    Set DocEnCours = Nothing
    Application.ScreenUpdating = True
    'MsgBox "Sauts de ligne inutiles effacés chef!"
 
   For IndexP = LBound(MatriceSauts, 2) To UBound(MatriceSauts, 2)
       Debug.Print "P : " & MatriceSauts(0, IndexP) & ", Nb Car : " & MatriceSauts(1, IndexP) _
                 & ", Chr(13) : " & MatriceSauts(2, IndexP) & ", Chr(12) : " & MatriceSauts(3, IndexP) _
                 & ", Chr(11) : " & MatriceSauts(4, IndexP) & ", Chr(10) : " & MatriceSauts(5, IndexP)
   Next IndexP
 
   HeureFin2 = Timer                        ' Définit l'heure de fin.
   TempsTotal2 = HeureFin2 - HeureDebut2    ' Calcule la durée totale.
   Debug.Print "Chef ! Chef ! J'ai mis " & Round(TempsTotal2, 1) & " seconde(s) pour traiter la procédure DeleteSautLigneVide !"
   MsgBox "Temps total du traitement DeleteSautLigneVide : " & Round(TempsTotal2, 1) & " seconde(s)"
 
 
End Sub

[Invité]

J'avais oublié que Debug.print était limité en nombre de lignes. Dans cette version, la matrice se déverse dans un fichier Excel :

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
 
Option Explicit
 
Public MatriceSauts() As Variant
Public IndexP As Long
 
Sub DeleteSautLigneVide2()
 
Dim HeureDebut2, HeureFin2, TempsTotal2
Dim DocEnCours As Document
Dim I As Long
Dim PositionChaine As Integer
 
    HeureDebut2 = Timer    ' Définit l'heure de début.
 
    Application.ScreenUpdating = False
 
    Set DocEnCours = Documents("exemple (1).docx")
 
    With DocEnCours
 
         Selection.HomeKey unit:=wdStory
 
    'vérifie la longueur du paragraphe
    IndexP = 0
    For I = .Paragraphs.Count To 1 Step -1
        With .Paragraphs(I).Range
             If InStr(1, .Text, Chr(13), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(12), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(11), vbTextCompare) > 0 _
             Or InStr(1, .Text, Chr(10), vbTextCompare) > 0 Then
 
               ReDim Preserve MatriceSauts(5, IndexP)
               MatriceSauts(0, IndexP) = I
               MatriceSauts(1, IndexP) = Len(.Text)
               MatriceSauts(2, IndexP) = InStr(1, .Text, Chr(13), vbTextCompare)
               MatriceSauts(3, IndexP) = InStr(1, .Text, Chr(12), vbTextCompare)
               MatriceSauts(4, IndexP) = InStr(1, .Text, Chr(11), vbTextCompare)
               MatriceSauts(5, IndexP) = InStr(1, .Text, Chr(10), vbTextCompare)
               IndexP = IndexP + 1
 
             End If
        End With
 
     Next I
 
     DeverserLesResulatsDansExcel DocEnCours
 
    End With
 
    Set DocEnCours = Nothing
    Application.ScreenUpdating = True
    'MsgBox "Sauts de ligne inutiles effacés chef!"
 
  ' For IndexP = LBound(MatriceSauts, 2) To UBound(MatriceSauts, 2)
  '     Debug.Print "P : " & MatriceSauts(0, IndexP) & ", Nb Car : " & MatriceSauts(1, IndexP) _
  '               & ", Chr(13) : " & MatriceSauts(2, IndexP) & ", Chr(12) : " & MatriceSauts(3, IndexP) _
  '               & ", Chr(11) : " & MatriceSauts(4, IndexP) & ", Chr(10) : " & MatriceSauts(5, IndexP)
  ' Next IndexP
 
   HeureFin2 = Timer                        ' Définit l'heure de fin.
   TempsTotal2 = HeureFin2 - HeureDebut2    ' Calcule la durée totale.
   Debug.Print "Chef ! Chef ! J'ai mis " & Round(TempsTotal2, 1) & " seconde(s) pour traiter la procédure DeleteSautLigneVide !"
   MsgBox "Temps total du traitement DeleteSautLigneVide : " & Round(TempsTotal2, 1) & " seconde(s)"
 
 
End Sub
 
 
Sub DeverserLesResulatsDansExcel(ByVal DocEnCours2 As Document)
 
Dim xlApp As Object
Dim FichierExcel As Object, ShExcel As Object
 
Dim FichierAOuvrir As Variant
Dim Repertoire As String
 
       Set xlApp = CreateObject("Excel.Application")
       Repertoire = DocEnCours2.Path  ' A adapter
       'FichierAOuvrir = Repertoire & "\" & "fichier_liste.xlsm"
       With xlApp
           .Visible = True
          Set FichierExcel = .workbooks.Add
          With FichierExcel
               Set ShExcel = .sheets(1)
               With ShExcel
                    .Range(.Cells(1, 1), .Cells(1, 6)) = Array("Paragraphe", "Nb car", "Chr(13)", "Chr(12)", "Chr(11)", "Chr(10)")
 
                    For IndexP = LBound(MatriceSauts, 2) To UBound(MatriceSauts, 2)
                        .Cells(IndexP + 2, 1) = MatriceSauts(0, IndexP)
                        .Cells(IndexP + 2, 2) = MatriceSauts(1, IndexP)
                        .Cells(IndexP + 2, 3) = MatriceSauts(2, IndexP)
                        .Cells(IndexP + 2, 4) = MatriceSauts(3, IndexP)
                        .Cells(IndexP + 2, 5) = MatriceSauts(4, IndexP)
                        .Cells(IndexP + 2, 6) = MatriceSauts(5, IndexP)
                    Next IndexP
               End With
               Set ShExcel = Nothing
 
             '  .Close savechanges:=False
        End With
        Set FichierExcel = Nothing
      End With
 
      'xlApp.Quit
      Set xlApp = Nothing
 
End Sub

[srekk]

Code :

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

1
2
 
Sub DeleteSautLigneVide2()

Bonjour Eric,

Désolée pour les délais, j'ai dû m'affairer ailleurs...

Ci-dessous le résultat du traitement sur les 96 pages du doc contenant 1543 paragraphes avec ta macro

Elle a mis 161sec... cent-soixante-et-une


test.xlsx

Je pense que le nombre de paragraphes est supérieur dans le résultats de ta macro car elle compte les paragraphes vides comme valables alors que word, dans ses statistiques, n'a pas l'air de les compter. Sinon je ne m'explique pas la différence dans le nombre de paragraphes...

Je dois t'avouer que je ne saisis pas où tu veux aller, mes connaissances sont loin (très loin) des tiennes...
;-)

Bien à toi,

Samantha

[Invité]

Bonjour Samantha,

Il y 161 lignes vides dans ton fichier. Regarde maintenant combien de temps met cette macro pour supprimer tes lignes vides.

• Est-ce qu'on arrive au même résultat au niveau des paragraphes restants ?
• Et combien de temps a-t-elle mis.

Si elle met plus de temps pas la peine de continuer... Ta méthode sera la meilleure.

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
 
 
Sub DeleteSautLigneVide3()
 
Dim HeureDebut2, HeureFin2, TempsTotal2
Dim DocEnCours As Document
Dim I As Long
 
    HeureDebut2 = Timer
 
    Application.ScreenUpdating = False
 
    Set DocEnCours = Documents("exemple (1).docx")
    With DocEnCours
         Selection.EndKey unit:=wdStory
         For I = .Paragraphs.Count To 1 Step -1
               With .Paragraphs(I).Range
                    If InStr(1, .Text, Chr(13), vbTextCompare) > 0 And Len(.Text) = 1 Then
                       .Select
                       Selection.Delete
                    End If
               End With
         Next I
    End With
 
    Set DocEnCours = Nothing
    Application.ScreenUpdating = True
 
    HeureFin2 = Timer
    TempsTotal2 = HeureFin2 - HeureDebut2
    MsgBox "Temps total du traitement DeleteSautLigneVide : " & Round(TempsTotal2, 1) & " seconde(s)"
 
End Sub

[srekk]

Bonjour Samantha,

Il y 161 lignes vides dans ton fichier. Regarde maintenant combien de temps met cette macro pour supprimer tes lignes vides.

• Est-ce qu'on arrive au même résultat au niveau des paragraphes restants ?
• Et combien de temps a-t-elle mis.

Si elle met plus de temps pas la peine de continuer... Ta méthode sera la meilleure.

Code :

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

1
2
3
4
5
 
 
Sub DeleteSautLigneVide3()
...
End Sub

Eric,

200 secondes... contre 76sec pour la mienne
Étrange, hier j'avais 17sec... mon ordi doit avoir des capacités variables...

Du coup j'ai cherché pourquoi...

Je viens de réaliser que le zoom d'affichage a une énorme influence sur les capacités de ma macro.
Si je demande un affichage "Page" 10% où je peux voir un grand nombre de pages à la fois, ma macro met environ 70 secondes
Si je demande un affichage "Page" 90% où je ne vois que la moitié d'une seule page ma macro ne met que 3 à 4 sec!!
La tienne aussi a obtenu une bien meilleure performance mais on atteint quand même 146 sec.

Au niveau mise en page, les sauts de page "vides" mais contenant des espaces ne sont pas effacés.
Les sauts de pages et saut de section sont conservés.
Il y a aussi un pb au niveau de certaines légendes au-dessus de tableau qui délirent après la macro je ne sais pas pourquoi.

D'ailleurs, la mienne aussi a une conséquence bizarre sur les images qui "disparaissent", leur format est bousillé (alignement sur le texte, texte autorisé au dessus et en dessous), elles sont là mais sont cachées par le texte des paragraphes au-dessus ou vont se mettre sur le haut des pages et sont aussi cachées... je chercher pour résoudre ce problème.

Dans tous les cas merci pour ton temps!

Excellente journée,


Samantha

[Invité]

Pour tes images, regarde le format de l'habillage (clic droit sur l'image) et modifie le pour voir si cela change quelque chose.