Supprimer le texte qui n'est pas entre deux lignes

**vibos** · 05/06/2009, 17h05

Bonjour,

Je dois extraire des données de PDF que je convertis en texte.
Une fois en texte, la partie qui m’intéresse est entre deux phrases.

Exemple :
Blabla
Phrase récurrente de début
Texte intéressant

Phrase récurrente de fin
Bla Bla

J’aimerai une macro qui efface tout sauf le texte intéressant.

Comme je dois le faire plus de mille fois une automatisation est la bienvenue :p

Merci.

**Heureux-oli** · 05/06/2009, 20h49

Salut,

Comme je dois le faire plus de mille fois une automatisation est la bienvenue :p

Mille documents ou mille fois dans le même document ?

**Sepia** · 08/06/2009, 01h36

Salut,

j'ai supposé que tu avais un seul document sinon tu devras faire une boucle sur le répertoire concerné en lançant la macro. Si c'est le cas, j'ai mis une garde en début de macro pour vérifier la phrase recherchée ("Phrase récurrente de début") est présente ou non.

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 EpurerTexte
    With Selection.Find
        .Text = "^pPhrase récurrente de début^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then
        Selection.HomeKey Unit:=wdStory
        Selection.Extend
        Selection.Find.Execute
        While Selection.Find.Found
            Selection.Delete Unit:=wdCharacter, Count:=1
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "^pPhrase récurrente de fin^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute
            Selection.Delete Unit:=wdCharacter, Count:=1
 
            With Selection.Find
                .Text = "^pPhrase récurrente de début^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Extend
            Selection.Find.Execute
        Wend
 
        Selection.EndKey
        Selection.Delete Unit:=wdCharacter, Count:=1
    End If
End Sub

Il est néanmoins nécessaire de répondre à Heureux-Oli, pour que l'on puisse mieux cibler le post (épurer le texte avec une recherche sur un document unique ou avec une recherche sur tous les documents d'un répertoire).

@+

**vibos** · 08/06/2009, 10h16

Merci beaucoup Sepia et Heureux-oli.
Effectivement je n’ai pas été clair.
Il y a bien plusieurs fichier différent mais avec la même présentation. (Les phrases récurrentes)
Je vais tester ça et je vous remercie encore pour votre aide

PS: je vais chercher comment faire la boucle sur le répertoire et je le rajouterai ici au cas ou quelqu'un est la même demande.

**vibos** · 08/06/2009, 17h30

bon j'ai trouver dans la faq pour l'appliquer à tous les dossiers.

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
Sub remplacement_Macro_Word()
Dim Debut As Integer, Lignes As Integer, X As Integer
Dim Fichier As String, Direction As String
Dim Doc As Document
Application.ScreenUpdating = False   'boucle sur tous les fichiers .dot du repertoire
Direction = "C:\l'adresse_du_repertoire"
Fichier = Dir(Direction & "\*.txt")
Do While Fichier <> ""
Set Doc = Documents.Open(Direction & "\" & Fichier)
 
 
Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " : "
        .Replacement.Text = ";"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
 
 
 
With Selection.Find
        .Text = "^pPhrase récurrente de début^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then
        Selection.HomeKey Unit:=wdStory
        Selection.Extend
        Selection.Find.Execute
        While Selection.Find.Found
            Selection.Delete Unit:=wdCharacter, Count:=1
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "^pPhrase récurrente de fin^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute
            Selection.Delete Unit:=wdCharacter, Count:=1
 
            With Selection.Find
                .Text = "^pPhrase récurrente de début^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Extend
            Selection.Find.Execute
        Wend
 
        Selection.EndKey
        Selection.Delete Unit:=wdCharacter, Count:=1
    End If
 
DoEvents
Doc.Close True
Set Doc = Nothing
Fichier = Dir
Loop
Application.ScreenUpdating = True
 
 
End Sub

Voili merci de votre aide

**vibos** · 09/06/2009, 15h50

Bonjour,

Je viens de me rendre compte que la macro n'effaçait que le début du fichier et pas les données après la phrase récurrente de fin et je n’arrive pas à la modifier.

Merci

**Heureux-oli** · 09/06/2009, 18h44

Salut,

Ne serait-il pas intéressant de tout mettre dans un seul fichier ?

**Sepia** · 10/06/2009, 02h24

Salut,

Envoyé par vibos

Je viens de me rendre compte que la macro n'effaçait que le début du fichier et pas les données après la phrase récurrente de fin et je n’arrive pas à la modifier.

Je ne comprends pas, chez moi c'est OK avec ton exemple. Sinon le code pour supprimer la fin du texte est le suivant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
        Selection.EndKey
        Selection.Delete Unit:=wdCharacter, Count:=1

situé juste avant le "End I" et "le "End Sub".

Remarque, le code fonctionne parce que le mode "Extension" est positionné.

@+

**vibos** · 10/06/2009, 14h30

Bonjour Sepia et Heureux-oli.

Ne serait-il pas intéressant de tout mettre dans un seul fichier ?

Non car après j'ai une macro excel qui traite les fichiers du dossiers et que leur nom me permet de remplir un autre tableau.

J'ai trouvé l'erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.Delete Unit:=wdCharacter, Count:=1

Il faut changer 1 par 20000 par exemple sinon il n'efface que la première ligne
la il efface les 20000 caractères.

Merci encore pour votre aide.

**Sepia** · 10/06/2009, 23h17

Salut,

Dans la macro, j'avais sélectionné tous les caractères à supprimer et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Selection.Delete Unit:=wdCharacter, Count:=1

supprime la sélection ==> pas besoin d'indiquer 20000 (normalement). Je ne comprends pas. Je viens de refaire avec les lignes que tu m'as donné comme exemple et ça marche (ça supprime tout ce qui est sélectionné qu'il y ait 2, 5 ou 5200 caractères ou lignes). Es-tu sûr que tu nous as donné la bonne syntaxe de ton fichier ?

Le fait que ça marche est bien (pour toi) mais ce n'est pas pédagogique pour les autres, la macro est OK chez moi ??? Bizarre. Peux-tu m'envoyer un fichier d'exemple (s'il ne contient pas d'informations confidentielles), STP que j'approfondisse, merci.

@+

**vibos** · 11/06/2009, 11h34

Bonjour Sepia,

T'envoyer le fichier est la moindre des chose après l'aide que tu m'a apporter

Et si ça peut en aider d'autre ou t'aider à comprendre le VBA, c'est parfait car c'est le but du forum.

Donc je te met en pièce jointe un fichier épurer des informations confidentiels mais qui ne marche pas quand même

Il faut enlever au moins le ^p après les phrase récurrente pour qu'il marche mieux.

changer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 .Text = "^pPhrase récurrente de fin^p"

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Text = "^pPhrase récurrente de fin"

Sinon il efface la première ligne du texte intéréssant.

Voilà j'espère que ça va t'éclairer et encore merci pour ton aide.

**Sepia** · 11/06/2009, 23h44

Salut vibos,

Je viens de récupérer ton fichier. Le problème venait des caractères accentués de recherche (enfin sur mon Mac), je les ai juste changer et c'est OK (j'ai mis en rouge les changements)

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
Sub EpurerTexte()
    With Selection.Find
        .Text = "^pPhrase rÈcurrente de dÈbut^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then
        Selection.HomeKey Unit:=wdStory
        Selection.Extend
        Selection.Find.Execute
        While Selection.Find.Found
            Selection.Delete Unit:=wdCharacter, Count:=1
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = "^pPhrase rÈcurrente de fin^w^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Find.Execute
            Selection.Delete Unit:=wdCharacter, Count:=1
            
            With Selection.Find
                .Text = "^pPhrase rÈcurrente de dÈbut^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            Selection.Extend
            Selection.Find.Execute
        Wend
        
        Selection.EndKey
        Selection.Delete Unit:=wdCharacter, Count:=1
    End If
End Sub

Sur ton exemple, voilà le fichier résultat. Comme tu me l'as demandé, je n'ai gardé que la zone comprise entre "Phrase récurrente de début" et "Phrase récurrente de fin". Tout le reste est supprimé.

@+

Supprimer le texte qui n'est pas entre deux lignes [Toutes versions]

VBA Word

Discussions similaires

Partager

Partager