Discussion :

[oamram]

Bonjour,

N'ayant pas suffisamment de connaissance en VBA, je recherche une personne qui pourrait m'écrire un petit script qui permettrait à partir d'un fichier WORD :

• D’effacer tout le contenu qui se trouverait devant la première utilisation du style "Titre 1"
• Ensuite qui découperait le fichier WORD en n documents RTF à chaque fois qu'il rencontrerait un Titre 1 (en y incluant le contenu depuis le Titre 1 jusqu'au Titre 1 suivant)

Merci d'avance pour votre aide.

[carden752]

Bonjour,

Comme expliqué dans les règles du forum, on ne fera pas le travail à ta place, cependant, on peut t'aider dans la méthodologie et les fonctions à utiliser.
La méthode la plus simple consiste à utiliser la méthode find (rechercher-Remplacer) puis d'étendre la sélection jusqu'au début et la supprimer.
Ensuite, il te suffira de faire le même type de recherche en boucle.
Voici un tutoriel sur cette fonction en VBA d'Olivier.
Rechercher-Remplacer en VBA

[oamram]

Voici la macro que j'ai réussie à construire pour la partie sélection et effacement :

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
Sub effacer_debut()
 
ActiveDocument.Range.Select
 
With Selection.Find
    .ClearFormatting
    .Text = ""
    .Style = "Titre 1"
    .Forward = True
 
    .Execute
 
End With
 
Selection.Move Unit:=wdParagraph, Count:=-1
Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
 
End Sub

Reste à découper le fichier en n fichiers...

[oamram]

Voici la suite de la macro qui permet de rechercher la même occurrence d'un style dans un document. Ici à titre d'exemple, la recherche du style "normal" que l'on surligne.

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
Sub SearchStyle()
 
Dim strStyle As String
 
strStyle = "Normal"
 
Selection.HomeKey Unit:=wdStory
With Selection.Find
    .Text = ""
    .ClearFormatting
    .Style = strStyle
    Do While .Execute
        Selection.Range.HighlightColorIndex = wdYellow
        ' Moves the insertion point to the end of a range
        ' sans cette action, on peut tomber dans une boucle infinie
        ' si le document contient aussi des tableaux !
        Selection.Collapse Direction:=wdCollapseEnd
    Loop
End With
 
End Sub

Une ligne importante, est la ligne suivante :

Code :

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

Selection.Collapse Direction:=wdCollapseEnd

qui comme indique la documentation Microsoft : "Moves the insertion point to the beginning or end of a range."

Sans cette ligne, la recherche de l'occurrence pourra s'arrêter et boucler indéfiniment dans certain cas, en particulier si votre document contient aussi des tableaux !!!

UPDATE

La solution ci-dessus ne fonctionne pas lorsque la fin du document est rencontrée, à nouveau une boucle infinie !

Voici une autre solution qui semble fonctionner dans tous les cas :

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
Sub SearchStyle2()
 
Dim strStyle As String
 
Selection.HomeKey Unit:=wdStory
With Selection.Find
    .ClearFormatting
    .Text = ""
    .Style = "Normal"
    Do While .Execute
         With .Parent
            If .End = ActiveDocument.Content.End Then
                Selection.Range.HighlightColorIndex = wdYellow
                Exit Do
             Else
                Selection.Range.HighlightColorIndex = wdYellow
                .Move Unit:=wdParagraph, Count:=1
             End If
         End With
    Loop
End With
 
End Sub

Auriez-vous d'autres pistes ou des améliorations à apporter à ce bout de code ?