Extraire des données précises dans un document word

Bonjour,

Cela fait assez longtemps que je n'ai pas fait de macro dans word et je sollicite votre aide.


Dans un document avec mise en forme style H3, j'ai une ligne de ce type :

XXXX Libellé commentaire

Ici je veux recuperer le XXXX qui sont les 4 premiers caractères de cette balise.

A chaque fois sur la ligne juste en dessous, je veux recuperer le nombre après EX.
ZZZ est différent à chaque fois, par contre (EX y est toujours.

Usage ZZZ (Ex 9999)

Au final, je veux une ligne avec 2 infos, dans un fichier ou dans excel avec XXXX et 9999

Je pose la question avant de développer, car je compte faire ce travail dans la journée de vendredi (et peu être un peu ce soir), toute aide ou piste est la bienvenue.

Dans mon esprit, il faut Rechercher la balise H3, ecrire les 4 premiers caractères se positionner sur la ligne en dessous, Rechercher "(EX ", se positionner après et jusqu'a la parenthèse fermante, et l'ecrire.

EDIT1, avec le code ci-dessous je parcours, les titres 3 et j'ai la premiere info qui m'interesse, reste à vérifier que la ligne du desous contient bien "EX " avant de récupérer l'info.

Code:

---

1 2 3 4 5 6 7

Dim oPara As Paragraph For Each oPara In ActiveDocument.Paragraphs If Left(oPara.Style, 7) = "Titre 3" Then Debug.Print Left(Trim(oPara.Range), 4) End If Next

---

Salut,

J'ai pas travaillé avec des titres, mais avec du texte simple.

Voilà une piste qui fonctionne pour la sélection du paragraphe suivant.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

Sub TestOli() Dim opar As Paragraph 'Boucle sur les paragraphes For Each opar In ActiveDocument.Paragraphs 'Recherche dans le texte du paragraphe une chaîne précise If Left(opar.Range.Text, 5) = "Maece" Then 'Si le texte est trouvé, on sélectionne le paragraphe opar.Range.Select 'On déplace la sélection au paragraphe suivant 'On étend la sélection à tout le paragraphe Selection.MoveDown unit:=wdParagraph, Count:=1 Selection.Expand unit:=wdParagraph Debug.Print Selection.Text End If Next opar   End Sub

---

Merci pour la réponse, pendant ce temps j'ai un peu avancé de mon côté et je butte sur la selection, une fois mon titre selectionné je n'arrive pas a le "dédelectionner" pour passer à la ligne suivante :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13

Sub zzz() Dim oPara As Paragraph, MaRubrique As String For Each oPara In ActiveDocument.Paragraphs If Left(oPara.Style, 7) = "Titre 3" Then MaRubrique = Left(Trim(oPara.Range), 4) oPara.Range.Select   Selection.MoveDown unit:=wdParagraph, Count:=1 ' ICI j'ai ce qui'il me faut dans MaRubrique, je veux lire la ligne suivante Selection.Expand unit:=wdParagraph   End If Next

---

EDIT : en gros c'est tout bête, ma ligne est selectionnée, je veux selectionner celle d'en dessous !

EDIT2 : Désolé je dois être fatigué, ce code le fait :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub zzz() Dim oPara As Paragraph, MaRubrique As String For Each oPara In ActiveDocument.Paragraphs If Left(oPara.Style, 7) = "Titre 3" Then MaRubrique = Left(Trim(oPara.Range), 4) oPara.Range.Select Selection.MoveDown unit:=wdParagraph, Count:=1 ' oPara.Range.EndOf unit:=wdParagraph   ' Selection.MoveDown unit:=wdParagraph, Count:=1 ' Selection.Expand unit:=wdParagraph   End If Next

---

Bon on avance, on avance, j'ai maintenant, toutes les lignes en titre 3 et a chaque fois j'arrive a lire la ligne d'en dessous.

Il faut maintenant que je puisse extraire la bonne donnée, si elle n'existe pas je n'ecrit rien si elle existe, j'écris la rubrique (l'ideal serait dans une colonne excel) et le numéro dans une autre colonne.
Sinon dans un fichier avec des points virgules.

EDIT : Voila ou j'en suis, je parcours le document, je test l'existence de EX, si ok selection, il mer reste à extraire les 4 caractères suivants, et surtout a ecrire le tout quelque part, dans le document 2 ou ailleurs !

Code:

---

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

Sub zzz() Dim obj2 As Document, obj1 As Document   Set obj1 = ActiveDocument Set obj2 = Documents.Add   obj1.Select Selection.HomeKey unit:=wdStory   Dim oPara As Paragraph, MaRubrique As String, MonEx As String For Each oPara In ActiveDocument.Paragraphs If Left(oPara.Style, 7) = "Titre 3" Then MaRubrique = Left(Trim(oPara.Range), 4) oPara.Range.Select Selection.MoveDown unit:=wdParagraph, Count:=1 Selection.Expand unit:=wdParagraph If recherche_rubrique(Selection, "(Ex ") = True Then ' OK MonEx = Selection   MsgBox Selection ' MonEx Else ' on passe au suivant End If End If Next       End Sub

---

Edit 2 : il me restera aussi le problème des lignes barrées, toute aide et toujours la bienvenue

Salut,

Quand on souhaite annuler une sélection, on fait un collapse et on choisit la direction du collapse.

Pour savoir où mettre les données, c'est à toi de voir.
Si c'est en Excel, il faudra utiliser la bibliothèque Excel.
Si c'est dans un document il faut le créer et l'utiliser.

Bonjour,


Finalement j'ai ecris dans un fichier texte, le code n'est pas très bien fait, mais bon j'obtiens bien ce que je voulais extraire, je le réecrirai, et le posterai quand ce serra fait. En attendant je mets sur résolu et vous remercie pour l'aide apportée.

Ecriture dans un fichier :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21

Dim intfic As Integer, nomAll As String nomAll = ThisDocument.Path & ".csv" intfic = FreeFile Open nomAll For Output As intfic   '... '...   Call ecrire_Ligne(MaRubrique & ";" & MonEx, intfic)   Close intfic   End sub   Sub ecrire_Ligne(AEcrire As String, intfic As Integer)     Print #intfic, AEcrire     End Sub

---