Discussion :

[Cocomarco]

Salut à tous

Ne pouvant trouver de réponse nulle part sur le forum (et sur tous les autres d'ailleurs) je m'en remet à vous car je suis perdue.

A la base, mes intentions sont simples: lancer une macro depuis excel qui ouvre un .doc dans un dossier, effectuer une recherche pour une mot clé et renvoyer la phrase contenant le mot clé dans ma feuille excel (et ce, pour chacun des .doc du dossier).

A partir de codes vba recuperé a droite et a gauche, j'ai assemblé ceci:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
79
80
81
82
83
84
85
 
 
Sub Import_Data()
 
' -- Variables declaration
Dim wb As Workbook          'classeur Excel dans lequel on importe les données
Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
Dim sChemin As String       'répertoire contenant les fichiers Word
Dim sNomFichier As String   'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object, WSel2 As Object
Dim i As Integer
Dim j As Integer
Dim FindMe As String        'mot clé aue l'on va rechercher
 
FindMe = InputBox(Prompt:=" Find a specific word ")
 
' -- Variables initialisation
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\"          'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\"           'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*")       'pour ouvrir tous les fichiers .doc*. 1er fichier.
 
 
Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True                        'ne pas afficher Word pendant l'exécution
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1   '1re ligne où on va écrire les données dans le fichier Excel
 
Application.ScreenUpdating = False
 
' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0
 
    Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
    Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression
 
    ' Nom du fichier
    ws.Cells(i, 1) = sNomFichier
 
    ' No de facture (par la fonction FIND)
    WApp.Selection.HomeKey unit:=6                          'Retourne au début du fichier Word
    WApp.Selection.Find.ClearFormatting                     'on "vide la mémoire" de la fonction Recherche
    With WApp.Selection.Find
        .Text = FindMe
        .Forward = True
'       .Wrap = wdFindStop
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 
    j = 1
    Do While WApp.Selection.Find.Execute = True
        j = j + 1
 
 
        Set WSel = WApp.Selection     
        ws.Cells(i, j) = WSel
 
    Loop
 
    i = i + 1                       'prochaine ligne
    WDoc.Close False                'fermer le document Word sans enregistrer
    sNomFichier = Dir               'prochain document
Loop
 
SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit                           'Fermer l'instance de Word
    Application.StatusBar = False       'Remise à zéro de la barre d'état
 
End Sub
 
 
Function ChoisirRepertoire() As String
' -- Fonction permettant de choisir un répertoire
    Dim oRepertoire As Object
    ChoisirRepertoire = ""
    Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
    If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
    Set oRepertoire = Nothing
End Function

Le probleme etant que je ne peux pas modifier ma selection pour selectionne toute une phrase sinon la methode find ne pourra pluss rechercher convenablement dans tout le document (ou alors c'est moi ai rien capté)

Comment pourrais-je selectionner la phrase entiere contenant le mot clé recherché, ecrire ma phrase en question dans ma cellule excel, et reprendre la recherche dans le .doc, etc etc..?? SVP!

J'ai essayé d'être la plus précise possible mais le VBA et moi c'est pas vraiment une histore d'amour!

Merci d'avance
Coralie

[Heureux-oli]

Salut,

Si tu étends ta sélection pour récupérer un paragraphe, tu peux toujours faire un collapse end pour déplacer ta sélection à la fin de ton paragraphe et ainsi continuer ta recherche.

[Cocomarco]

Bonjour,

Merci de ta reponse.

J'y suis finalement arrivee en arrengeant quelque chose de la sorte. J'etends ma selection a droite et a gauche et ensuite j'utilise la fonction collapse. Je ne sais pas, toutefois, si j'ai utilise la syntaxe la plus simple. Voici mon code mis a jour:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
 
Sub Import_Data()
 
' -- Variables declaration
Dim wb As Workbook          'classeur Excel dans lequel on importe les données
Dim ws As Worksheet         'onglet Excel dans lequel on importe les données
Dim sChemin As String       'répertoire contenant les fichiers Word
Dim sNomFichier As String   'nom du fichier Word
Dim WApp As Object, WDoc As Object, WSel As Object, WSel2 As Object
Dim i As Integer
Dim j As Integer
Dim Max As Integer
Dim findMe As String
 
 
findMe = InputBox(Prompt:=" Find a specific word ")
Max = 2
 
' -- Variables initialisation
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
sChemin = ChoisirRepertoire & "\"          'fonction pour choisir le répertoire contenant les fichier Word
'sChemin = ThisWorkbook.Path & "\"           'si les fichiers Word se trouvent dans le même répertoire que le fichier Excel
sNomFichier = Dir(sChemin & "*.doc*")       'pour ouvrir tous les fichiers .doc*. 1er fichier.
 
 
Set WApp = CreateObject("Word.Application") 'pour créer un objet Word
WApp.Visible = True                        'ne pas afficher Word pendant l'exécution
i = ws.Range("A" & Rows.Count).End(xlUp).Row + 1   '1re ligne où on va écrire les données dans le fichier Excel
 
Application.ScreenUpdating = False
 
' -- Boucle sur les fichiers
Do While Len(sNomFichier) > 0
 
    Set WDoc = WApp.Documents.Open(sChemin & sNomFichier)   'ouvre le document Word
    Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression
 
    ' Nom du fichier
    ws.Cells(i, 1) = sNomFichier
    ws.Cells(i, 2) = findMe
 
    ' No de facture (par la fonction FIND)
    WApp.Selection.HomeKey Unit:=6                          'Retourne au début du fichier Word
    WApp.Selection.Find.ClearFormatting                     'on "vide la mémoire" de la fonction Recherche
    With WApp.Selection.Find
        .Text = findMe
        .Forward = True
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 
    j = 2
    Do While WApp.Selection.Find.Execute = True
 
        j = j + 1
        WApp.Selection.MoveStart Unit:=2, Count:=-5
        WApp.Selection.MoveRight Unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        ws.Cells(i, j) = WSel
        WApp.Selection.collapse Direction:=0
 
        If j > Max Then Max = j
 
    Loop
 
    i = i + 1                       'prochaine ligne
    WDoc.Close False                'fermer le document Word sans enregistrer
    sNomFichier = Dir               'prochain document
Loop
 
SortieNormale:
    Application.ScreenUpdating = True
    WApp.Quit                           'Fermer l'instance de Word
    Application.StatusBar = False       'Remise à zéro de la barre d'état
 
 
'Call the Sub to highlight the serached word
Bolding findMe, i, Max
 
End Sub
 
'====================================
'Function to chose the folder containing the .doc files
'====================================
 
Function ChoisirRepertoire() As String
    Dim oRepertoire As Object
    ChoisirRepertoire = ""
    Set oRepertoire = CreateObject("Shell.Application").BrowseForFolder(0, "Choisir un répertoire", 0)
    If (Not oRepertoire Is Nothing) Then ChoisirRepertoire = oRepertoire.Items.Item.Path
    Set oRepertoire = Nothing
End Function
 
 
'====================================
'Function to highlight the searched word
'Arguments: findMe -> string to be bolded, i -> last unempty row of the sheet, Max -> last unempty column of the sheet
'====================================
 
Sub Bolding(ByVal findMe As String, ByVal i As Integer, ByVal Max As Integer)
 
Dim rng As Range
Dim fin As Long
Dim cell As Range
Dim celltxt As String
 
'MsgBox findMe & " - " & i & " - " & Max
 
Set rng = ThisWorkbook.Sheets(1).Range(ActiveSheet.Cells(2, 2), ActiveSheet.Cells(i + 1, Max + 1))
fin = Len(findMe)
 
For Each cell In rng
    celltxt = cell.Text
    If InStr(1, celltxt, findMe) <> 0 Then
        With cell.Characters(Start:=InStr(1, celltxt, findMe), Length:=fin).Font
            .FontStyle = "Bold"
            .Color = -16776961
        End With
    End If
Next
End Sub

Coralie