Recherche a partir d'Excel dans Word

Question

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:	est.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

cs_Nicko11 · Answer

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.

cs_Nicko11 · Answer

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.

cs_Nicko11 · Answer

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	est.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+

marcdid · Answer

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!

cs_Nicko11 · Answer

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).

cs_Nicko11 · Answer

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	est.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

marcdid · Answer

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:	est.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

Recherche a partir d'Excel dans Word

7 réponses

Votre réponse

Discussions similaires