Macro sous Word

[C@thy]

Bonjour,

je dispose d'une population de 1500 personnes environ, une personne par page.

je cherche à écrire une macro sous Word permettant de faire ceci :
sur chaque page je veux transformer chaque marque de paragraphe par une tabulation, sauf la dernière de la page (sinon le 2ème élément se trouve collé au 1er!)

ensuite (plus dur!) je veux rajouter une tabulation avant et après ce qui est écrit en Tahoma gras Italique.

Le but étant ensuite de le transformer en .txt et de l'ouvrir en colonnes sous Excel. Je joins un exemple de fichier.

Mille mercis à celles et ceux qui pourraient m'aider.

Biz

C@thy

 

[Catrice]

Re : Macro sous Word

Bonjour à tous,

Pierrof, j'ai du mal également à faire les remplacements sur tu proposes.
Je perds du texte ...

C@thy, j'ai trouvé un moyen (un peu lourd) de regler le probleme du Tahoma.
Voir le code (complet) ci-dessous.
Dis-moi, si ça fonctionne chez toi.

Sub Transforme()
' Rajoute les sauts de page et supprime ceux du Style Titre 1
For Each X In ActiveDocument.Paragraphs
If X.Style = "Titre 1" Then
ActiveDocument.Range(X.Range.Start, X.Range.Start).InsertBreak Type:=wdPageBreak
End If
Next
' Enleve les sauts de pages du style Titre 1
ActiveDocument.Styles("Titre 1").ParagraphFormat.PageBreakBefore = False
' Remplace les paragraphes par des tabulations
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^p"
.Replacement.Text = "^t"
End With
Selection.Find.Execute Replace:=wdReplaceAll
RemplaceTahoma
End Sub
Sub RemplaceTahoma()
For i = ActiveDocument.Words.Count - 1 To 2 Step -1
With ActiveDocument
If .Words(i).Font.Name = "Tahoma" And .Words(i).Font.Italic = True And .Words(i).Font.Bold = True Then
If .Words(i - 1).Font.Name <> .Words(i).Font.Name Or .Words(i - 1).Font.Italic <> .Words(i).Font.Italic Or .Words(i - 1).Font.Bold <> .Words(i).Font.Bold Then
.Words(i).InsertBefore Chr(9)
End If
End If
If .Words(i).Font.Name = "Tahoma" And .Words(i).Font.Italic = True And .Words(i).Font.Bold = True Then
If .Words(i + 1).Font.Name <> .Words(i).Font.Name Or .Words(i + 1).Font.Italic <> .Words(i).Font.Italic Or .Words(i + 1).Font.Bold <> .Words(i).Font.Bold Then
.Words(i).InsertAfter Chr(9)
End If
End If
End With
Next
End Sub

 

[Pyrof]

Re : Macro sous Word

Bonjour,

Le principe sans macro:

On sait que le paragraphe affecté du Titre 1 est le début d'une personne, que sous excel il doit être place en première colonne.
Les autres paragraphe (concernant cette personne) doivent être dans les colonnes suivantes d'où nécessité de remplacer les retours chariot par tabulation.

Dans un premier temps il nous faut marquer le début de chaque personne par un rechercher sur le nom du style (Titre 1) et remplacer par "[PYROF]" ou tout autre code.

Dans un deuxième, il faut remplacer tous les retours par des tabulations. Dans cette situation, tout le fichier est en un seul paragraphe.

Troisième action, remplacer "[PYROF]" ou votre code par un retour.

Ainsi, chaque personne commencera un paragraphe.

Il ne reste plus qu'à faire un copier coller dans excel.

Bon courrage

 

[Catrice]

Re : Macro sous Word

re,

Pierrof, je crois que j'ai bien compris le principe de ce que tu proposes et ça me semble théoriquement la meilleur solution. Mais je ne dois pas savoir faire le remplacement du style sous Word car cela ecrase le texte formaté en "Titre 1" (étape N°1)
Merci pour tes lumieres.

 

[Pyrof]

Re : Macro sous Word

regarde

si tu a encore des problèmes joint moi ton fichier word (-de 50 k et tu changes l'extension .doc en .xls pour pouvoir le joindre)

 

[Pyrof]

Re : Macro sous Word

Toute mes excuses
il faut remplacer Titre1 par [PYROF]^&

j'avais oublié ^& qui veut dire texte trouvé

 

[Catrice]

Re : Macro sous Word

Re,

Merci pour tes précisions.
Effectivement, le ^& arrange la situation

Mais ça ne va pas quand meme car (je crois) il y a 2 "Titre 1" qui sont collés => le remplacement n'en prend qu'un ...
Si je les séparent, ça fonctionne.

C'est pour ça que dans ma macro, je scanne chaque paragraphe et regarde comment il est formaté. Si c'est un Titre 1 je mets un saut de page (j'aurais pu effectivement faire un remplacement avec le ^& mais C@thy a parlé à un moment de vouloir garder le saut de page alors ...)
Ensuite je modifie le Titre 1 en enlevant le "Saut de page avant".
Enfin, je remplace les paragraphes par des Tab. Là il n'y a plus besoin de réfléchir aux changements de lignes, ce sont les sauts de pages précédemment insérés qui s'en chargent.


Le fait de passer par macro évite quand meme pas mal de manips un peu tordues surtout s'il y a régulierement des fichiers à traiter.

En revanche, j'ai rencontré des problèmes pour gérer le Tahoma Gras Italique avec Rechercher/Remplacer d'où une boucle sur les mots du documents

NB - le fichier pour tester est dans le premier Post de C@thy.

 

[Pyrof]

Re : Macro sous Word

Essais dans le troisième remplacer par ^p^m et la tu conserve ton saut de page


A+

 

[C@thy]

Re : Macro sous Word

Un grand MERCI à toi, Pyrof, ton aide m'est précieuse.

Grâce à Google j'ai trouvé des réponses que tu as données sur d'autres sites et je les ai engrangées pour en profiter.

Si je souhaite utiliser une macro c'est parceque j'ai plusieurs fichiers, donc si j'écris le (bonne!) macro une fois, je la fais tourner sur les autres fichiers et youpi!!!

j'essaie de remplacer la virgule et le point par une tabulation dans tout ce qui est Tahoma gras italique,

j'ai bidouillé un truc à pertir du code que tu as posté sur un autre site
mais ça marche pas (il me dit 0 remplacement alors qu'il y en a)

' Remplacer virgule espace Tahoma gras italique par tabulation
Selection.WholeStory
With Selection.Find
.Text = ","
.Font.Name = "Tahoma"
.Font.Italic = 1
.Font.Bold = 1
.Replacement.Text = "^t"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Merci pour ton aide si précieuse.

C@thy

 

[Pyrof]

Re : Macro sous Word

bonjour,

voilà la macro qu'il faut:

Selection.HomeKey unit:=wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
.text = ","
.Font.name = "Tahoma"
.Font.Italic = 1
.Font.Bold = 1
.Replacement.text = "^t"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

 

[Pyrof]

Re : Macro sous Word

C'est encore moi,

Je viens de m'apercevoir que tu veux changer le point et la virgule par une tabulation.
On peut faire les 2 en 1 seul remplacement
Selection.HomeKey unit:=wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
.text = "[,.]" ' -------------------------- point ou virgule
.Font.name = "Tahoma"
.Font.Italic = 1
.Font.Bold = 1
.Replacement.text = "^t"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True ' ------------------ utilisation des caractères spéciaux
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

 

[C@thy]

Re : Macro sous Word

Youpiiiiiiiiiiiiiiiiiii c'est génial!!!

je teste ça tout de suite.

Un grand MERCI

J'ai fait un petit récap dans le zip joint

Bises

C@thy

 

[C@thy]

Re : Macro sous Word

mon PC rame un max, je n'avais pas la fenêtre pour joindre les fichiers, donc voici le Zip.

Hélas, trois fois hélas (Babylas, casse-moi la gueule ou j'te la casse... citation apprise à l'école primaire!!!), le remplacement ne se fait pas! Gasp!

Test avec fichier joint

Bibises et grand merci à toi, mon cas est difficile!!! (voire désespéré!)

C@thy

 

[Pyrof]

Re : Macro sous Word

Il semblerait qu'il y ait un conflit de police, si tu mets:

'.Font.name = "Tahoma"

ça passe

Quand on fait le rechercher remplacer manuellement, ça fonctionne
avec la macro non ??????????????????????????

Par expérience, il arrive que des fonctionnalités marche manuellement et pas en macro, et le comble c'est que lorsque l'on fait du pas à pas ça fonctionne bien. Bizarre vous avez bizarre ....

Dans ton cas, est-il vraiment nécessaire de tester Tahoma est ce que gras ital ne serait pas suffisant.

 

[C@thy]

Re : Macro sous Word

Mercu Pyrof, je crois que tu as compris mon problème.

Word n'arrive pas à faire de sélections discontinues, alors que sous OpenOffice cela se fait très facilement, il y a un bouton sélectionner tout.

Je pense que je peux m'en sortir autrement :

je supprime tout ce qui est en Times New Roman et j'enregistre sous carrière ensuite je remplace tout ce que je veux

dans un 2ème temps je fais l'inverse, je repars du fichier d'origine, je supprime ce qui est Tahoma ensuite je supprime le paragraphe qui contient Oeuvres puis celui qui contient LH puis celui qui contient ONM et ce qui commence par * j'enregistre sous un autre nom et je fais mes manips, ensuite je repars du fichier d'origine et je ne garde que le nom prénom et les lignes oeuvres, LH, ONM et je fais mes manips.

Dans ce cas, j'ai une question :

lorsque je trouve le mot LH, comment sélectionner tout le paragraphe? (excuse ma question de novice, les macros Word c'est pas ma tasse de thé).

En tout cas merci pour toute ton aide, c'est vraiment SUPER.

Bises et bonne journée

C@thy

 

[Pyrof]

Re : Macro sous Word

Bonjour,

Je pense qu'il faut bien cibler ce dont tu doit conserver.
A partir de l'original, il faut cibler les textes que tu doit garder en les marquant par ce qu'on appelle une balise de début et de fin, balises que nous supprimerons ensuite. Il faut aussi marqué ces textes en police bleu par exemple.
A la fin tout ce qui n'est pas en bleu est à effacer.

Je te joins une macro qui va marquer les LH

Selection.HomeKey unit:=wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
.text = "(^013)(LH[.,][!^013]{1;})(^013)"
.Replacement.text = "\1{]LH[}\2{]/LH[}\1"
.Replacement.Font.Color = wdColorBlue
.Forward = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With


Selection.HomeKey unit:=wdStory
With Selection.find
.ClearFormatting
.Replacement.ClearFormatting
.text = "(^013)(O. ONM[.,][!^013]{1;})(^013)"
.Replacement.text = "\1{]ONM[}\2{]/ONM[}\1"
.Replacement.Font.Color = wdColorBlue
.Forward = True
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With

ça pour chaque cas

Bon courage