Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    Effacer les sauts de ligne inutiles sans effacer les sauts de page ou de section
    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

  2. #2
    Expert éminent sénior
    Citation Envoyé par srekk Voir le message

    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.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  3. #3
    Candidat au Club
    Citation Envoyé par Eric KERGRESSE Voir le message
    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.



    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

  4. #4
    Expert éminent sénior
    Citation Envoyé par srekk Voir le message

    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 :




    Après traitement :



    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
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  5. #5
    Expert éminent sénior
    Citation Envoyé par srekk Voir le message

    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
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  6. #6
    Candidat au Club
    Citation Envoyé par Eric KERGRESSE Voir le message


    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




    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

  7. #7
    Expert éminent sénior
    Citation Envoyé par srekk Voir le message

    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
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter

  8. #8
    Candidat au Club
    Citation Envoyé par Eric KERGRESSE Voir le message
    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

  9. #9
    Expert éminent sénior
    Citation Envoyé par srekk Voir le message

    Pour tes images, regarde le format de l'habillage (clic droit sur l'image) et modifie le pour voir si cela change quelque chose.
    Eric KERGRESSE
    https://sites.google.com/site/erickergresseeirl/
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter