Recherche a partir d'Excel dans Word

marcdid Messages postés 12 Date d'inscription samedi 7 février 2004 Statut Membre Dernière intervention 29 mai 2007 - 29 mai 2007 à 04:17
marcdid Messages postés 12 Date d'inscription samedi 7 février 2004 Statut Membre Dernière intervention 29 mai 2007 - 29 mai 2007 à 16:28
Messieurs,
 
Je lutte un peu pour écrire une macro excel pour traiter un fichier word. Je souhaiterais qu'elle:
 
- ouvre le fichier word en question
- parcourt le fichier word a la recherche d'un certain mot
-
à chaque fois qu'elle trouve le mot, copier un certain nombre de
caractères qui suivent ce mot dans la cellule A1 du fichier excel
-
continuer ceci jusqu'a la fin du fichier word en copiant à chaque fois
dans le fichier excel les caractères  dans les cellules suivantes
A2,A3....
 
Voila mon code, le pb est que il s'arrète à la première occurence trouvée...

 
Sub Extraction()

 
    Dim appWD As New Word.Application

    Dim DocWD As New Word.Document

    Set DocWD = appWD.Documents.Open("C:\test.txt" )

     
    appWD.Visible = True

    appWD.Selection.Find.ClearFormatting

     
    With appWD.Selection.Find

        .Text = "numéro:"

        .Replacement.Text = ""

        .Forward = True

        .Wrap = wdFindContinue

        .Format = False

        .MatchCase = False

        .MatchWholeWord = False

        .MatchWildcards = False

        .MatchSoundsLike = False

        .MatchAllWordForms = False

    End With

   

     
    Do While appWD.Selection.Find.Execute("numéro:" ) = True

        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=1

        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend

        appWD.Selection.Copy

        Range("A1" ).Select

        ActiveSheet.Paste

        ActiveCell.Offset(1, 0).Select

    Loop

     
DocWD.Close True

appWD.Quit

Set DocWD = Nothing

Set appWD = Nothing

 
End Sub

Un grand merci pour votre aide!
 
Paul

7 réponses

cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
29 mai 2007 à 09:02
Salut, en effet, je cherches mais je vois pas pourquoi. Tu as pourtant un exemple tres proche de celui de l'aide.

J'ai remplacé Selection par ActiveDocument.Content mais rien n'y change.
0
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
29 mai 2007 à 09:13
Tu vas pas le croire je viens de trouvé. Ouvre ton fichier Txt avec word et regarde comment c'est écrit "numéro".

Ca doit venir du codage du fichier texte.

Donc c'est normal que tu ne trouve pas le mot en question puisque word ecrit différemment.

Essaies en remplacant les "numéro" par "numero" (c a d sans l'accent) et moi ca a fonctionné directe.
0
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
29 mai 2007 à 09:26
voila, c'est bon j'ai la solution,

modifie la méthode open comme ceci:

    Set DocWD = appWD.Documents.Open("C:\Documents and Settings\BorelNi\Bureau\test.txt", Encoding:=msoEncodingWestern)

et tu verras que word affiche bien et que par consequent, le nom est bien trouvé. Dis moi si ca resoud ton pb.

A+
0
marcdid Messages postés 12 Date d'inscription samedi 7 février 2004 Statut Membre Dernière intervention 29 mai 2007
29 mai 2007 à 14:32
Salut Nicko,

Tout d'abord merci pour ton aide!! J'ai modifié le script comme tu me le conseilles mais la boucle Do while ne marche toujours pas. En fait il copie colle bien la première occurence mais ensuite il s'arrête et donc ne copie colle pas les autres présentes dans le fichier! Le test Do While appWD.Selection.Find.Execute("numéro:" ) = True  est-il bon dans la boucle?

Encore merci!
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
29 mai 2007 à 15:43
Je te mets le code que j'ai modifié (et qui marche nickel):

et OUI ton test est bon.

Le truc, c'est que je viens de trouvé un bug. Quand j'execute et que je remet au premier plan le fichier text a chaque occurence ca marche.
J'essaies de trouver d'ou cela viens (essaies aussi de voir ca).
0
cs_Nicko11 Messages postés 1141 Date d'inscription mercredi 7 mars 2007 Statut Membre Dernière intervention 19 septembre 2007 3
29 mai 2007 à 15:48
Public Sub Extraction()
 
    Dim appWD As New Word.Application
    Dim DocWD As New Word.Document
    Set DocWD = appWD.Documents.Open("C:\Documents and Settings\BorelNi\Bureau\Test_Module\test.txt", Encoding:=msoEncodingWestern)
    
    appWD.Visible = True
    
    With appWD.Selection.Find
        .ClearFormatting
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
    
    Do While appWD.Selection.Find.Execute("numero:") = True
        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=1
        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
        appWD.Selection.Copy
        Range("A1").Select
        ActiveSheet.Paste
        ActiveCell.Offset(1, 0).Select
    Loop
    
DocWD.Close True
appWD.Quit
Set DocWD = Nothing
Set appWD = Nothing


End Sub
0
marcdid Messages postés 12 Date d'inscription samedi 7 février 2004 Statut Membre Dernière intervention 29 mai 2007
29 mai 2007 à 16:28
Je viens de trouver, voici le code qui marche! (j'ai mis en gras les 2 modifs). En fait il me sélectionnait tout le document et s'arrêtait.
Merci pour ton aide Nicko!
+

Sub Extraction()
 
    Dim appWD As New Word.Application
    Dim DocWD As New Word.Document
    Set DocWD = appWD.Documents.Open("C:\test.txt" )
     
    appWD.Visible = True
    appWD.Selection.Find.ClearFormatting
     
    With appWD.Selection.Find
        .Text = "numéro:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
   Range("A1" ).Select
    
    Do While appWD.Selection.Find.Execute("numéro:" ) = True
        appWD.Selection.MoveRight Unit:= wdCharacter, Count:=1
        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=2, Extend:=wdExtend
        appWD.Selection.Copy
        appWD.Selection.MoveRight Unit:=wdCharacter, Count:=1
        ActiveSheet.Paste
        ActiveCell.Offset(1, 0).Select
    Loop
     
DocWD.Close True
appWD.Quit
Set DocWD = Nothing
Set appWD = Nothing
 
End Sub
0