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("D10" ).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Loop
DocWD.Close True
appWD.Quit
Set DocWD = Nothing
Set appWD = Nothing
End Sub
Message édité par pauldid le 29-05-2007 à 04:13:44