Word - Supprimer lignes vides dans 5000 fichiers

Marsh Posté le 29-04-2008 à 07:48:41

Bonjour,
j'ai 5000 ordonnances médecin (dans un seul dossier) à remettre en forme pour les intégrer dans un nouveau logiciel.
Voici un exemple d'ordonnance:

<TAB><TAB><TAB>
<^p>
<^p>
<^p>
<^p>
<^p>
<^p>
<TAB><TAB><TAB> Madame DUPONT
<^p>
<^p>
<^p>
EUTHYRAL<^p>
un comprimé le matin au petit déjeuner 30 jours renouvelable 2 fois

et je voudrai obtenir ceci:

<^p>
EUTHYRAL<^p>
un comprimé le matin au petit déjeuner 30 jours renouvelable 2 fois

- boucle sur 5000 fichiers:
- boucle pour supprimer toutes les lignes vides (y compris celles contenant des tabulations et des espaces)
- supprimer 1 ligne non-vide
- boucle pour supprimer toutes les lignes vides
- insérer marque paragraphe

Quelqu'un sur le net m'a déjà pondu une macro, mais elle est incomplète. La boucle d'ouverture/enregistrement de fichier marche, mais la boucle de suppression de ligne est incomplète, et elle ne détecte pas les lignes avec tabulations ou espaces.

Sub boucleFichier()
Dim oFs As New FileSystemObject
Dim oDir As Folder
Dim oFil As File
Dim oDia As FileDialog
Dim stRep As String
Dim oDoc As Document

Set oDia = Application.FileDialog(msoFileDialogFolderPicker)
oDia.Show
stRep = oDia.SelectedItems(1)
Set oDir = oFs.GetFolder(stRep)
For Each oFil In oDir.Files

Set oDoc = Documents.Open(stRep & "\" & oFil.Name)
' La boucle de remplacement
Dim pAra As Paragraph

For Each pAra In oDoc.Paragraphs
If Len(pAra.Range.Text) = 1 Then
pAra.Range.Delete
Else
pAra.Range.Delete
GoTo ici
End If
Next pAra
ici:
oDoc.Save

oDoc.Close
Set oDoc = Nothing

Next oFil

Set oFs = Nothing
Set oDir = Nothing
Set oDia = Nothing

End Sub

Si quelqu'un a une idée, merci d'avance :love:

Reply

Marsh Posté le 29-04-2008 à 07:48:41

Reply

Marsh Posté le 29-04-2008 à 11:30:33

Deux questions :

- Quel caractère exactement est le <^p> ? un simple carriage return ?
- Quel est le format exact de tes ordonnances : TXT, DOC, autre ?

Message édité par ZeBix le 29-04-2008 à 11:32:16

Reply

Marsh Posté le 29-04-2008 à 16:18:51

Bonjour,

^p = ^013 = retour chariot

pour remplacer plusieurs retours consécutifs faire un rechercher remplacer avec critères spéciaux

rechercher : "^013{2;}"
remplacer : "^p"

Reply

Marsh Posté le 30-04-2008 à 08:21:57

salut,

<^p> est un simple retour charriot; le format des ordonnances est du .doc

Je résume le problème simplement:
j'ai besoin d'une macro qui :
- place la sélection en début de fichier
- (A) supprime toutes les lignes vides jusqu'à la première ligne non-vide. Attention: certaines lignes vides comportent des espaces et des tabulations!
- (B) supprime la première ligne non vide.
- (A) supprime toutes les lignes vides jusqu'à la première ligne non-vide.

si vous avez une idée sur les routines (A) et (B), même si ce n'est pas une macro complète, c'est pas grave, je teste!!

Merci d'avance :love:

Message édité par Bilboket le 30-04-2008 à 08:25:39

Reply

Marsh Posté le 30-04-2008 à 10:50:44

J'ai pondu ma première macro, qui a l'immense avantage de ne rien faire du tout!! :pt1cable:
Help ! :hello:

'aller début document
Selection.HomeKey unit:=wdStory, Extend:=wdExtend

'tant que sélection active= retour charriot <cr> ou espace ou tabulation

While (((Selection.Text) = Chr(13)) Or ((Selection.Text) = Chr(32)) Or ((Selection.Text) = Chr(9)))

Select Case (Selection.Text)

' si tabulation
Case (Chr(9))

'méthode Microsoft pour selectionner jusqu'au retour charriot vbCr
With Selection
.MoveEndUntil Cset:=vbCr, Count:=wdForward
.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With

' methode personnelle ! pour supprimer la selection et
' aller au début ligne suivante
Selection.Delete unit:=wdItem
Selection.MoveDown wdLine, 1, wdMove
Selection.HomeKey wdLine, wdMove

Case (Chr(32))
With Selection
.MoveEndUntil Cset:=vbCr, Count:=wdForward
.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Delete unit:=wdItem
Selection.MoveDown wdLine, 1, wdMove
Selection.HomeKey wdLine, wdMove
End With

' recopié depuis ce forum même
Case (Chr(13))
Selection.Delete unit:=wdCharacter, Count:=1
Selection.MoveDown wdLine, 1, wdMove
Selection.HomeKey wdLine, wdMove

End Select

Wend

Message édité par Bilboket le 30-04-2008 à 10:52:53

Reply

Marsh Posté le 30-04-2008 à 11:06:42

Bonjour,

Pour supprimer les retours chariots multiple:

Selection.HomeKey unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.MatchWildcards = true
.Text = "[^032^009]{1;}^013"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With
Selection.HomeKey unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.MatchWildcards = true
.Text = "[^013]{2;}3"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With

Reply

Marsh Posté le 30-04-2008 à 15:33:25

super pyrof! Merci!
la première routine marche, il supprime bien les tabs et les espaces!
Génial! (3 jours que je suis dessus) :wahoo:
C'est un premier point.

Par contre, la seconde ne marche pas. Il ne trouve pas l'expression "[^013]{2;}3" dans le fichier, donc ne supprime pas les <CR>. Une erreur?

Ensuite, je voudrais limiter la recherche à la portion de début du document, non à la totalité :

- supprimer les premières lignes blanches composées de <SPC>, <TAB> ou <CR>
- supprimer la première ligne non-vide (nom_du_patient)
- supprimer les lignes blanches suivantes composées de <CR>, jusqu'à la première ligne de texte (mais pas après)

Exemple:

Au départ on a :

<TAB><TAB><TAB><TAB><TAB><CR>
<SPC><SPC><SPC>
<CR>
<CR>
<CR>
<CR>
<CR>
Mlle Audrey DUPONT<CR>
<CR>
<CR>
<CR>
CHROMIUM METALLICUM 15 CH 2 tubes<CR>
3 granules au réveil à commencer si possible 7 jours avant les soins dentaires, finir les tubes<CR>

A l'arrivée, on veut:

<CR>
CHROMIUM METALLICUM 15 CH 2 tubes<CR>
<CR>
3 granules au réveil à commencer si possible 7 jours avant les soins dentaires, finir les tubes

Message édité par Bilboket le 30-04-2008 à 15:33:54

Reply

Marsh Posté le 30-04-2008 à 15:37:14

Désolé j'ai fait une erreur de frappe

"[^013]{2;}" au lieu de "[^013]{2;}3"

Pour le reste, je n'ai pas trop de temps je verrais

Reply

Marsh Posté le 01-05-2008 à 12:50:52

J'ai écrit ce code à partir de différentes parties qu'on m'a données:
Il me manque une methode (au milieu, en rouge en gras).
Si quelqu'un a une idée...

Sub boucleFichier()

Dim oFs As New FileSystemObject
Dim oDir As Folder
Dim oFil As File
Dim oDia As FileDialog
Dim stRep As String
Dim oDoc As Document
Dim pAra As Paragraph

Set oDia = Application.FileDialog(msoFileDialogFolderPicker)
oDia.Show
stRep = oDia.SelectedItems(1)
Set oDir = oFs.GetFolder(stRep)
Set oDoc = Documents.Open(stRep & "\" & oFil.Name)
Set pAra = ActiveDocument.Paragraphs(1)

Call supprimer_lignes_vides

SI LE PREMIER MOT DE LA LIGNE COURANTE CONTIENT "MONSIEUR" OU "MADAME"
OU "MADEMOISELLE" OU "MR" OU "MME" OU "MLLE" ALORS SUPPRIMER CETTE LIGNE

' Then pAra.Range.Delete ?

' on continue à supprimer les lignes vides
Call supprimer_lignes_vides

' on insere une ligne vide pour espacer
Selection.TypeParagraph

End If

oDoc.Save

oDoc.Close

Set oDoc = Nothing
Set oFs = Nothing
Set oDir = Nothing
Set oDia = Nothing

End Sub

__________________________________________________________

Sub supprimer_lignes_vides()

While ((Asc(pAra.Range.Text) = 32) Or (Asc(pAra.Range.Text) = 13) Or (Asc(pAra.Range.Text) = 9))

pAra.Range.Delete
pAra.Next

Wend

End Sub

Reply

Marsh Posté le 02-05-2008 à 11:15:26

Bonjour,

Voici une méthode :

Sub Macro6()
traite "monsieur"
traite "madame"
traite "mademoiselle"
End Sub

Private Sub traite(mot)
Selection.HomeKey unit:=wdStory
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = ""
.MatchWildcards = False
.Text = Chr(13) & mot
.Execute
End With
While Selection.Find.Found
Selection.MoveRight
Selection.MoveStartUntil cset:=Chr(12) & Chr(13), Count:=wdBackward
Selection.MoveEndUntil cset:=Chr(13), Count:=wdForward
Selection.DeleteSelection.Find.Execute
Wend
End Sub

Reply

Word - Supprimer lignes vides dans 5000 fichiers

Sujets relatifs:

Leave a Replay