Récupérer occurences de texte dans Excel

Version imprimable

17/12/2006, 01h15
fgreg306

Récupérer occurences de texte dans Excel

Bonjour,

Le problème est simple, je pars d'un fichier WORD dans lequel je souhaite récupérer dans un classeur excel, toutes les occurences de texte se trouvant entre 2 chaines de caractères (du style [%N] et [N%]).

Pour élaborer cette fonction VBA, je souhaiterai utiliser la métrode FIND de WORD pour accélérer la procédure (GROS DOC) et ne pas charger tout le document dans une string

Bonjour, bienvenue sur le forum,
Deux choses : Pour trouver toutes les occurences d'un mot dans Excel ou dans Word, il suffit de lancer la recherche sur le bout de mot que tu cherches sans préciser "mot entier" pour word ou "cellule entière" pour Excel, ce qui est la recherche par défaut de l'un ou de l'autre.
Ensuite, pour faire une recherche dans Excel, tu devras utiliser une syntaxe Excel.
Pour ça, tu as deux solutions, ou tu instancies l'appli Excel et utilises une syntaxe VBA Excel, ou tu préfères travailler sur un fichier fermé, auquel cas une recherche dans la FAQ ou sur le forum te fournira le code.
Pour ouvrir Excel et travailler sur une feuille, un exemple :
Code:

1 2 3 4 5 6 7 Dim xlApp As Object Dim wbk As Object Set Activdoc = ActiveDocument Set xlApp = CreateObject("excel.application") Set wbk = xlApp.Workbooks.Open("d:\médoc\FichierExcel.xls") ' Définit le fichier EXCEL à ouvrir xlApp.Visible = True wbk.Sheets("Feuil1").Activate
Là, je n'ai pas le temps d'aller + loin mais tu as une infinité d'exemples de recherche sur Excel, sur le forum. Bouton recherche ou Bouton FAQ dans la barre d'outils du forum.
Bonne journée

17/12/2006, 12h30
fgreg306

Merci c'est très sympa pour le côté récupération dans Excel, mais c'est le côté de recherche dans WORD qui pose problème, c'est à dire récupérer toutes les occurences se trouvant entre deux chaines de caratères (du style [%N] et [N%])

Coucou, je suis revenu ;)
Ta recherche se fait dans word ou dans Excel ?
Si elle se fait dans word, tu cherches la première occurence, puis la seconde en utilisant "ExtendMode". Ex. :

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
Sub SélectionnerUnePlageDeTexte()
Dim Mot1 As String, Mot2 As String
    Mot1 = "est installé"
    Mot2 = "informations"
    Selection.HomeKey Unit:=wdStory 'envoie en début de document
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = Mot1
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Execute
    End With
    With Selection
        .ExtendMode = True 'Permet la selection de la plage
        With Selection.Find
            .Text = Mot2
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Execute
        End With
    End With
End Sub

Tu dis
A+

yes

En fait le problème est d'extraire des données de WORD
Je récupère toutes les occurences se trouvant entre deux chaines de caractères : N£ et £N

Je les importe dans une table Access

C'est OK et voici le code (sûrement perfectible)

Merci et je suis preneur pour les commentaires

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
Option Compare Database
Option Explicit
 
Dim Word_Application As Word.Application
 
Function Word_Chercher_Texte(Texte As Variant, Dernier As Boolean) As Boolean
  With Word_Application
    With .Selection.Find
      .ClearFormatting
      .Text = Texte
      .Replacement.Text = ""
      .Forward = Not Dernier
      .Wrap = IIf(Dernier = True, wdFindAsk, wdFindContinue)
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = True 'Caractères génériques dans recherche
      .MatchAllWordForms = False
      Word_Chercher_Texte = .Execute
    End With
  End With
End Function
 
Public Function Word_Extraction_Ref() As String
Dim Ligne As String
Dim Tmp As String
Dim PosDeb As Integer
Dim PosFin As Integer
 
  Ligne = Word_Application.Selection
  PosDeb = InStr(1, Ligne, "N£") + 2
  PosFin = InStr(1, Ligne, "£N")
  Tmp = Mid(Ligne, PosDeb, PosFin - PosDeb)
  If Trim(Tmp) <> "" Then
    Word_Extraction_Ref = Trim(Tmp)
  Else
    Word_Extraction_Ref = ""
  End If
End Function
 
Sub Importation()
Dim Ref As String
Dim LastRef As String
 
  On Error GoTo Err_importation
  DoCmd.SetWarnings False
  DoCmd.Hourglass True
 
  Set Word_Application = New Word.Application
  Word_Application.Visible = False
  Word_Application.Documents.Open ("C:\Import\Source.doc")
  DoCmd.RunSQL "DELETE * FROM Import"
  If Word_Chercher_Texte("(N£)*(£N)", True) Then
    LastRef = Word_Extraction_Ref
    Do
      Ref = ""
      If Word_Chercher_Texte("(N£)*(£N)", False) Then
        Ref = Word_Extraction_Ref
        CurrentDb.Execute "INSERT INTO Import (Référence) VALUES ('" & Ref  & "')"
      End If
    Loop Until Ref = LastRef
  End If
  Word_Application.Documents.Close False
 
Finaly:
  On Error Resume Next
  Word_Application.Quit
  Set Word_Application = Nothing
 
  DoCmd.Hourglass False
  DoCmd.SetWarnings True
  MsgBox "Terminé"
  Exit Sub
Err_importation:
  MsgBox "Erreur " & Err.Number & " : " & Err.Description
  Resume Finaly
End Sub