Reconstruire des phrases découpées par des retours de chariots - Word 2007 - Macro

excel12

XLDnaute Nouveau
Bonjour, :)

J'ai une histoire dont toutes les phrases ont été découpées par des retours de chariots. Donc, une même phrase est malheureusement écrite sur plusieurs lignes. De plus, il y a des centaines de phrases.

Je souhaite avoir une macro qui me permettre de reconstruire les phrases ensemble. Je tiens à préciser également que je veux seulement une phrase par ligne.

(J'ai ajouté le symbole «¶» qui est affiché dans Word pour indiquer les retours de chariots)
Voici un exemple d'un fragment du texte que je désire traiter avec une macro:

Comment va-t-on enseigner dans le futur ? ¶
J'ai une idée, ¶
mais pour vous dévoiler mon idée, ¶
je dois vous raconter une histoire¶
pour planter le décor! ¶
J'ai cherché¶
d'où venait la façon¶
dont on enseigne à l'école... ¶
Vous pouvez revenir loin dans le temps, ¶
mais si vous regardez la façon dont on enseigne aujourd'hui¶
c'est assez facile de comprendre d'où cela vient. ¶

Je souhaite obtenir exactement le résultat suivant après le travail de la macro:
Comment va-t-on enseigner dans le futur ? ¶
J'ai une idée, mais pour vous dévoiler mon idée, je dois vous raconter une histoire pour planter le décor! ¶
J'ai cherché d'où venait la façon dont on enseigne à l'école... ¶
Vous pouvez revenir loin dans le temps, mais si vous regardez la façon dont on enseigne aujourd'hui c'est assez facile de comprendre d'où cela vient. ¶


« ^p » permet de trouver les retours de chariots. Donc, si le caractère avant le retour de chariot est un point (.), un point d'interrogation (?) ou un point d'exclamation (!)
. ¶
? ¶
! ¶
Cela signifie que c'est la fin de la phrase et que je ne veux pas qu'on élimine le retour de chariot, puisque je souhaite une phrase par ligne.

Si c'est un autre caractère que les 3 mentionnés ( . ? !), cela signifie que c'est une coupure de phrase et qu'il faut supprimer le retour de chariot (¶) et ajouter un espace.

Voici ce que j'ai pensé programmer. Je sais, la macro ne fonctionne toujours pas. Mais j'ai vraiment fait au maximum de mes capacités de programmation.

Si vous avez une meilleure idée avec un code totalement différent, ne pas hésiter à tout changer.

De plus, si vous pouvez ajouter des commentaires, c'est génial pour aider les débutants à bien comprendre ce que fait le code.


-----------------------------------------------------------------------------------------------

Sub Macro1()
Selection.GoTo wdGoToPage, wdGoToFirst ' Allez au début.
Do While True
Selection.Find.Text = "*^p" <> "*^p" 'Exécuter la boucle jusqu'à ce qu'on ne trouve plus de retour de chariot dans la page

Selection.Find.Execute
With Selection.Find ' On considère le caractère courant
If Selection.Find.Text = "*^p" And Selection.Find <> "*.^p" And Selection.Find <> "*?^p" And Selection.Find <> "*!^p" Then 'Trouver la fin de la phrase
Selection.Find.Text = "*^p" 'Il faut laisser le retour de chariot, car c'est la fin de la phrase
Else
.Replacement.Text = " " 'Il faut remplacer le retour de chariot par un espace, car c'est le milieu de la phrase
End If
End With
Loop
End Sub

-----------------------------------------------------------------------------------------------



À votre bon coeur, messieurs, dames :)

Excel12
 

homepyrof53

XLDnaute Occasionnel
Re : Reconstruire des phrases découpées par des retours de chariots - Word 2007 - Mac

Bonjour,

Voici une autre macro

Code:
Sub essai()

Selection.HomeKey unit:=wdStory

With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = Chr(182)
    .Replacement.Text = ""
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
End With


With Selection.Find
    .Text = "([.\?\!…])[ ]{1;}" & Chr(11)
    .Replacement.Text = "\1^p"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

With Selection.Find
    .Text = "([.\?\!…]){1;}" & Chr(11)
    .Replacement.Text = "\1^p"
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
End With

With Selection.Find
    .Text = "[ ]{1;}" & Chr(11)
    .Replacement.Text = Chr(11)
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
End With
With Selection.Find
    .Text = Chr(11)
    .Replacement.Text = " "
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 069
Messages
2 085 042
Membres
102 765
dernier inscrit
richdi