1. #1
    Membre du Club
    Profil pro
    Inscrit en
    mars 2002
    Messages
    53
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : mars 2002
    Messages : 53
    Points : 41
    Points
    41

    Par défaut Réorganiser les paragraphes dans un texte selon leur style

    Bonjour,

    je souhaite réorganiser du texte en me basant sur le style des paragraphes
    Il s'agit de traductions de textes où la traduction a été organisée paragraphe par paragraphe, la traduction étant finie je souhaite séparée la partie originale et la traduite.

    Voici comment est organisé :
    Titre du texte 1 [Style Titre1]

    Paragraphe 1 en langue d'origine [Style Paragraphe Quechua]

    Paragraphe 1 traduit en français [Style Normal]

    Paragraphe 2 en langue d'origine [Style Paragraphe Quechua]

    Paragraphe 2 traduit en français [Style Normal]
    .....

    Titre du texte 2 [Style Titre1]

    Paragraphe 1 en langue d'origine [Style Paragraphe Quechua]

    Paragraphe 1 traduite en français [Style Normal]
    .....
    Le résulat souhaite est le suivant :

    Titre du texte 1 [Style Titre1 Quechua]

    Paragraphe 1 en langue d'origine [Style Paragraphe Quechua]
    Paragraphe 2 en langue d'origine [Style Paragraphe Quechua]
    ....

    Titre du texte 1 [Style Titre1 Français]
    Paragraphe 1 traduit en français [Style Paragraphe Français]
    Paragraphe 2 traduit en français [Style Paragraphe Français]
    .....

    Titre du texte 2 [Style Titre1 Quechua]
    Paragraphe 1 en langue d'origine [Style Paragraphe Quechua]
    ....

    Titre du texte 2 [Style Titre1 Français]
    Paragraphe 1 traduite en français [Style Paragraphe Français]
    .....
    J'avais réussi à faire la réorganisation en recopiant le texte ( avec le champ Paragraph.Range.Text) mais je perdais les notes de bas de page.
    J'ai voulu refaire le script avec les méthode Copy/Paste mais je bloque.

    Voici mon code, je bloque principalement sur la mise en variable de la sélection copiée

    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
     
    Sub A_split()
        Dim App As Application
        Dim para As Paragraph
     
        Dim target As Document
        Dim source As Document
     
        Set source = ActiveDocument
        Set target = Documents.Add("S:\Public\Users\Florent\Google Drive\Modèle mémoire quechua-fr.dotm", NewTemplate:=False, DocumentType:=0)
     
    ' Ajout de deux signets pour insérer le texte original et sa traduction
        target.Bookmarks.Add ("book_original")
        target.Bookmarks.Add ("book_traduct")
     
        For Each para In source.Paragraphs
            Dim SelectPara As Selection
            para.Range.Select
     
    ' C'est ici que rien ne fonctionne
    '        Set SelectPara = App.Selection
            Selection.Copy
     
     
            If para.Style = "Titre 1" Then
                RemplirSignet target, "book_original", SelectPara ', "Titre 1 Quechua"
                RemplirSignet target, "book_traduct", SelectPara ', "Titre 1 Français"
            End If
     
            If para.Style = "Normal" Then
                RemplirSignet target, "book_traduct", SelectPara ', "Paragraphe Français"
            End If
     
            If para.Style = "Paragraphe Quechua" Then
                RemplirSignet target, "book_original", SelectPara ', "Paragraphe Quechua"
            End If
     
        Next para
    End Sub
     
    Public Function RemplirSignet(Doc As Document, A As String, B As Selection) ', C As Style)
    ' Remplit le signet A avec le texte B sans détruire A
    On Error GoTo sortie
    Dim Place As Long
     
    Place = Doc.Bookmarks(A).Range.Start
    Doc.Bookmarks(A).Range = B.Paste
    Doc.Bookmarks.Add Name:=A, Range:=ActiveDocument.Range(Place, Place + Len(B))
    sortie:
    End Function
    Merci

  2. #2
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 490
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 490
    Points : 6 477
    Points
    6 477
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par florent Voir le message
    Bonsoir,

    En imaginant que votre document soit dupliqué, le code suivant supprime les styles choisis dans chacun des documents :
    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
     
     
    Sub SupprimerLesParagraphesDUnStyle(ByVal DocEncours As Document, ByVal LeStyleASupprimer As String)
     
    Dim I As Long
     
        With DocEncours
             For I = .Paragraphs.Count To 1 Step -1
                 If .Paragraphs(I).Style = LeStyleASupprimer Then .Paragraphs(I).Range.Delete
             Next I
        End With
     
    End Sub
     
     
    Sub TesterSupprimerLesParagraphesDUnStyle()
     
    Dim DocumentNormal As Document
    Dim DocumentQuecha As Document
     
        Set DocumentNormal = Documents("Doc1.docm")
        SupprimerLesParagraphesDUnStyle DocumentNormal, "Paragraphe Quechua"
        Set DocumentNormal = Nothing
     
        Set DocumentQuecha = Documents("Doc2.docm")
        SupprimerLesParagraphesDUnStyle DocumentQuecha, "Normal"
        Set DocumentQuecha = Nothing
     
    End Sub
    Une fois les suppressions terminées, vous pouvez faire un copier-coller d'un des documents sur le deuxième.
    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
    Membre du Club
    Profil pro
    Inscrit en
    mars 2002
    Messages
    53
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : mars 2002
    Messages : 53
    Points : 41
    Points
    41

    Par défaut

    Bonsoir Eric,

    Merci pour ce retour, c'est en effet une méthode envisageable, mais il faut absolument que les deux versions du texte se succèdent, si bien qu'au début j'avais envisagé de déplacer le texte à l'intérieur même du document, cela m'a vite semblé trop complexe donc je me suis orienté vers la recopie dans un document nouveau.

    Cela étant, je reste curieux de comprendre pourquoi je n'arrive pas stocker dans une variable la sélection (via un Range.Copy pour conserver les notes de bas de page) et le transmettre à une fonction.

    Cordialement
    Florent

  4. #4
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 490
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 490
    Points : 6 477
    Points
    6 477
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par florent Voir le message

    Mon précédent code organisait les paragraphes selon l'ordre des styles. En passant par des matrices de position, les paragraphes apparaissent dans l'ordre des titres puis des styles.

    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
     
    Sub OrganiserLesTraductions()
     
    Dim DocSource As Document, DocCible As Document
    Dim ParagrapheTitre As Paragraph
    Dim MatriceDesTitres() As Variant, MatriceStyleNormal() As Variant, MatriceStyleQuechua() As Variant
    Dim I As Integer, J As Integer
    Dim NbParagraphesTitre As Integer, NbParagraphesNormaux As Integer, NbParagraphesQuechua As Integer
    Dim MonRangeTitre As Range, MonRangeCible As Range
    Dim StyleTitre As String, StyleNormal As String, StyleQuechua As String, Titre1EnCours As String
     
     
        StyleTitre = "Titre 1"
        StyleNormal = "Normal"
        StyleQuechua = "Sous-titre"  ' A adapter
     
        Set DocSource = ActiveDocument
        With DocSource
     
             NbParagraphesTitre = 0
             NbParagraphesNormaux = 0
             NbParagraphesQuechua = 0
     
             For I = 1 To .Paragraphs.Count
     
                 Select Case .Paragraphs(I).Style
                        Case StyleTitre
                               Titre1EnCours = .Paragraphs(I).Range.Text
                               ReDim Preserve MatriceDesTitres(1, NbParagraphesTitre)
                               MatriceDesTitres(0, NbParagraphesTitre) = Titre1EnCours
                               MatriceDesTitres(1, NbParagraphesTitre) = I
                               NbParagraphesTitre = NbParagraphesTitre + 1
                        Case StyleNormal
                               ReDim Preserve MatriceStyleNormal(1, NbParagraphesNormaux)
                               MatriceStyleNormal(0, NbParagraphesNormaux) = Titre1EnCours
                               MatriceStyleNormal(1, NbParagraphesNormaux) = I
                               NbParagraphesNormaux = NbParagraphesNormaux + 1
                        Case StyleQuechua
                               ReDim Preserve MatriceStyleQuechua(1, NbParagraphesQuechua)
                               MatriceStyleQuechua(0, NbParagraphesQuechua) = Titre1EnCours
                               MatriceStyleQuechua(1, NbParagraphesQuechua) = I
                               NbParagraphesQuechua = NbParagraphesQuechua + 1
                 End Select
             Next I
     
        End With
     
        Set DocCible = Documents.Add
        With DocCible
     
             For I = LBound(MatriceDesTitres, 2) To UBound(MatriceDesTitres, 2)
     
                 Set MonRangeTitre = DocSource.Paragraphs(MatriceDesTitres(1, I)).Range
                 MonRangeTitre.Copy
                 .Paragraphs.Add
                 Selection.Paste
     
     
                For J = LBound(MatriceStyleQuechua, 2) To UBound(MatriceStyleQuechua, 2)
                    If MatriceStyleQuechua(0, J) = MatriceDesTitres(0, I) Then
                       Set MonRangeCible = DocSource.Paragraphs(MatriceStyleQuechua(1, J)).Range
                       MonRangeCible.Copy
                       .Paragraphs.Add
                       Selection.Paste
                       Set MonRangeCible = Nothing
                    End If
                Next J
     
                MonRangeTitre.Copy
                .Paragraphs.Add
                Selection.Paste
     
                For J = LBound(MatriceStyleNormal, 2) To UBound(MatriceStyleNormal, 2)
                    If MatriceStyleNormal(0, J) = MatriceDesTitres(0, I) Then
                       Set MonRangeCible = DocSource.Paragraphs(MatriceStyleNormal(1, J)).Range
                       MonRangeCible.Copy
                       .Paragraphs.Add
                       Selection.Paste
                       Set MonRangeCible = Nothing
                    End If
                Next J
     
                Set MonRangeTitre = Nothing
             Next I
     
        End With
        Set DocCible = Nothing
        Set DocSource = 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

  5. #5
    Membre du Club
    Profil pro
    Inscrit en
    mars 2002
    Messages
    53
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : mars 2002
    Messages : 53
    Points : 41
    Points
    41

    Par défaut

    Bonsoir Eric,

    tout d'abord milles merci pour ce code, j'apprécie le temps que tu y as consacré !

    Je continue d'ajouter des fonctionnalités au code pour mes besoins, notamment la mise en forme après le paste, la seule méthode que j'ai trouvé et la mise en place d'un compteur que j'incrémente à chaque Paragraph.Add mais je ne trouve pas cela très élégant. aurais-je pu faire mieux ?

    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
                MonRangeTitre.Copy
                .Paragraphs.Add
                Selection.Paste
                .Paragraphs(Pos).Style = ActiveDocument.Styles("Titre 1 Français")
                Pos = Pos + 1
     
                For J = LBound(MatriceStyleNormal, 2) To UBound(MatriceStyleNormal, 2)
                    If MatriceStyleNormal(0, J) = MatriceDesTitres(0, I) Then
                       Set MonRangeCible = DocSource.Paragraphs(MatriceStyleNormal(1, J)).Range
                       MonRangeCible.Copy
                       .Paragraphs.Add
                       Selection.Paste
                       .Paragraphs(Pos).Style = ActiveDocument.Styles("Paragraphe Français")
                       Pos = Pos + 1
                       Set MonRangeCible = Nothing
                    End If
                Next J
    j'ai aussi un comportement bizarre, il me génère beaucoup de caractères "Entrée" (char 13) à la fin du document, as tu constaté le même fonctionnement ?

    Merci encore

  6. #6
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 490
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 490
    Points : 6 477
    Points
    6 477
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par florent Voir le message
    aurais-je pu faire mieux ?
    Il faut modifier la sélection en cours après avoir collé le titre qui doit être de style Quechua en première partie. Exemple :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
                 With Selection
                    .Paste
                    .MoveUp unit:=wdLine, Count:=1
                    .EndKey unit:=wdLine, Extend:=wdExtend
                    .Style = StyleQuechua
                    .MoveDown unit:=wdLine, Count:=1
                    'MsgBox .Range.Text
                 End With
    Le code devient :
    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
     
    Sub OrganiserLesTraductions()
     
    Dim DocSource As Document, DocCible As Document
    Dim ParagrapheTitre As Paragraph
    Dim MatriceDesTitres() As Variant, MatriceStyleNormal() As Variant, MatriceStyleQuechua() As Variant
    Dim I As Integer, J As Integer
    Dim NbParagraphesTitre As Integer, NbParagraphesNormaux As Integer, NbParagraphesQuechua As Integer
    Dim MonRangeTitre As Range, MonRangeCible As Range
    Dim StyleTitre As String, StyleNormal As String, StyleQuechua As String, Titre1EnCours As String
     
     
        StyleTitre = "Titre 1"
        StyleNormal = "Normal"
        StyleQuechua = "Sous-titre"  ' A adapter
     
        Set DocSource = ActiveDocument
        With DocSource
     
             NbParagraphesTitre = 0
             NbParagraphesNormaux = 0
             NbParagraphesQuechua = 0
     
             For I = 1 To .Paragraphs.Count
     
                 Select Case .Paragraphs(I).Style
                        Case StyleTitre
                               Titre1EnCours = .Paragraphs(I).Range.Text
                               ReDim Preserve MatriceDesTitres(1, NbParagraphesTitre)
                               MatriceDesTitres(0, NbParagraphesTitre) = Titre1EnCours
                               MatriceDesTitres(1, NbParagraphesTitre) = I
                               NbParagraphesTitre = NbParagraphesTitre + 1
                        Case StyleNormal
                               ReDim Preserve MatriceStyleNormal(1, NbParagraphesNormaux)
                               MatriceStyleNormal(0, NbParagraphesNormaux) = Titre1EnCours
                               MatriceStyleNormal(1, NbParagraphesNormaux) = I
                               NbParagraphesNormaux = NbParagraphesNormaux + 1
                        Case StyleQuechua
                               ReDim Preserve MatriceStyleQuechua(1, NbParagraphesQuechua)
                               MatriceStyleQuechua(0, NbParagraphesQuechua) = Titre1EnCours
                               MatriceStyleQuechua(1, NbParagraphesQuechua) = I
                               NbParagraphesQuechua = NbParagraphesQuechua + 1
                 End Select
             Next I
     
        End With
     
        Set DocCible = Documents.Add
        With DocCible
     
             For I = LBound(MatriceDesTitres, 2) To UBound(MatriceDesTitres, 2)
     
                 Set MonRangeTitre = DocSource.Paragraphs(MatriceDesTitres(1, I)).Range
                 MonRangeTitre.Copy
                 .Paragraphs.Add
                 With Selection
                    .Paste
                    .MoveUp unit:=wdLine, Count:=1
                    .EndKey unit:=wdLine, Extend:=wdExtend
                    .Style = StyleQuechua
                    .MoveDown unit:=wdLine, Count:=1
                    'MsgBox .Range.Text
                 End With
     
     
                For J = LBound(MatriceStyleQuechua, 2) To UBound(MatriceStyleQuechua, 2)
                    If MatriceStyleQuechua(0, J) = MatriceDesTitres(0, I) Then
                       Set MonRangeCible = DocSource.Paragraphs(MatriceStyleQuechua(1, J)).Range
                       MonRangeCible.Copy
                       .Paragraphs.Add
                       Selection.Paste
                       Set MonRangeCible = Nothing
                    End If
                Next J
     
                MonRangeTitre.Copy
                .Paragraphs.Add
                Selection.Paste
     
                For J = LBound(MatriceStyleNormal, 2) To UBound(MatriceStyleNormal, 2)
                    If MatriceStyleNormal(0, J) = MatriceDesTitres(0, I) Then
                       Set MonRangeCible = DocSource.Paragraphs(MatriceStyleNormal(1, J)).Range
                       MonRangeCible.Copy
                       .Paragraphs.Add
                       Selection.Paste
                       Set MonRangeCible = Nothing
                    End If
                Next J
     
                Set MonRangeTitre = Nothing
             Next I
     
        End With
        Set DocCible = Nothing
        Set DocSource = Nothing
     
    End Sub

    j'ai aussi un comportement bizarre, il me génère beaucoup de caractères "Entrée" (char 13) à la fin du document, as tu constaté le même fonctionnement ?
    Non, car mon document ne fait qu'une page et je lui ai ajouté deux à trois notes de bas de page et une note de fin. Il y a peut-être d'autres objets qui sont passés à la trappe dans cette transformation. Si c'est à la fin, cela ne doit pas être trop gênant.
    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

  7. #7
    Expert éminent

    Homme Profil pro
    Développeur Vba Excel
    Inscrit en
    avril 2013
    Messages
    2 490
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : Développeur Vba Excel
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : avril 2013
    Messages : 2 490
    Points : 6 477
    Points
    6 477
    Billets dans le blog
    19

    Par défaut

    Citation Envoyé par florent Voir le message
    j'ai aussi un comportement bizarre, il me génère beaucoup de caractères "Entrée" (char 13) à la fin du document, as tu constaté le même fonctionnement ?
    Le code ci-dessous supprime les lignes vides et décroche au premier paragraphe non vide.
    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
     
    Sub SupprimerLesLignesVides(ByVal DocEnCours As Document)
     
    Dim J As Integer, NbRemplacements As Integer
     
       ' NbRemplacements = 0
        With DocEnCours
             For J = .Paragraphs.Count To 1 Step -1
                 With .Paragraphs(J)
                      If Len(.Range.Text) = 1 Then
                         'NbRemplacements = NbRemplacements + 1
                         .Range.Delete
                      Else
                        Exit For
                      End If
     
                 End With
             Next J
        End With
        'MsgBox NbRemplacements
     
    End Sub
    Procédure à insérer dans le code principal
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
        SupprimerLesLignesVides DocCible
     
        End With
        Set DocCible = Nothing
        Set DocSource = 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

Discussions similaires

  1. Remplacer les espaces dans un texte
    Par jouclar dans le forum Général Python
    Réponses: 13
    Dernier message: 26/05/2008, 00h26
  2. Supprimer les insultes dans un texte oui mais...
    Par psychoBob dans le forum Débuter
    Réponses: 19
    Dernier message: 16/04/2008, 16h03
  3. Trouver toutes les dates dans un texte
    Par Shandler dans le forum Regex
    Réponses: 7
    Dernier message: 16/04/2008, 10h56
  4. Réponses: 3
    Dernier message: 07/09/2007, 15h14
  5. Recuperer les colonnes d'une table selon leur nom
    Par lolo_momo dans le forum MS SQL-Server
    Réponses: 4
    Dernier message: 20/07/2007, 12h56

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo