Extraction données Word vers Excel

Version imprimable

Bonjour à toutes et tous,

Après avoir longuement surfer sur ce site et forum depuis des long mois et avoir appris les rudimments du language VBA, je viens à bloquer sur un point.

Je tiens à vous remercier pour tout le contenu proposés.

Donc ma problèmatique est la suivante :

A travers un fichier excel, j'ouvre une multitude de fichier Word qui se trouve dans un dossier. Ensuite, je cherche à extraire des données. Mais comme un code vaut mieux que des mots :

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
79
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
' Par : Grand Chaman Excel -- 2013/03/05
'-----------------------------------------------------------------
Sub Importation_Donnees_Word()
 
    ' -- Déclaration des variables
    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
    Dim i As Integer
    Dim MaVariable As String
 
 
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = "\\p\.... ..... .... ..."         '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
 
    MaVariable = InputBox("Veuillez renseigner le rang de la pièce concerné svp", "Titre", "XX")
 
    sNomFichier = Dir(sChemin & "*" & MaVariable & "*.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
        WApp.Selection.Find.Execute "n° PV INDUSTRIEL"    'On trouve le texte "No Facture"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i, 2) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par 2 ":"
 
 
        ' Ref du produit (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
        WApp.Selection.Find.Execute "Référence fabricant attendue "   
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i, 3) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
 
 
        ' Ref du produit (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
        WApp.Selection.Find.Execute "n° DE SERIE "    
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(i, 4) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
 
 
        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

Et mon problème est le suivant :

La 3éme recherche doit s'effectuer dans l'entête du document, et pour le moment, je ne trouve rien dutout pour y acceder...

Merci d'avance si vous avez des solutions.

Citation:

Envoyé par christo0

Bonjour,

Le code ci-dessous permet de lire les entêtes de section :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub Test()
 
    LireEnTeteDePage ActiveDocument
 
End Sub
 
Sub LireEnTeteDePage(ByVal DocEncours As Document)
 
Dim sEc As Section
Dim I As Integer
 
    For Each sEc In DocEncours.Sections
        If sEc.Headers.Count > 0 Then
           For I = 1 To sEc.Headers.Count
               With sEc.Headers(I)
                    Debug.Print .Range.Text
               End With
           Next I
        End If
    Next sEc
 
End Sub

09/01/2018, 14h40
christo0

Bonjour,

merci de votre réponse,

Je n'arrive pas à utiliser ce morceau de code dans le mien, comment activer la lecture de l'entête pour chaque recherche dans l'entête ? J'ai essayer de bidouiller mais je ne comprend pas comment votre code fonctionne.

j'ai essayer d'inserer

Code:

ActiveSheet.PageSetup.RightHeader

sans résultat
09/01/2018, 15h07
Invité

Citation:

Envoyé par christo0

Les entêtes se trouvent dans les parties Section du document. Si vous activez la fenêtre exécution dans votre éditeur VBA, la commande Debug.print va vous indiquer le contenu de chaque entête.
09/01/2018, 15h21
christo0

je suis désolé mais je ne comprend pas dutout.

mon code fonctionne très bien, mais je veux juste faire une recherche dans l'entête lors de ma 3éme recherche.

Je n'arrive pas à faire fonctionner votre code "LireEnTeteDePage" et encore moins à l'assimiler au mien.

il n'y a aucune façon simple d'indiquer à la fonction Find de s'effectuer dans l'entête du document word ? svp

Citation:

Envoyé par christo0

Votre question du départ est de savoir comment accéder aux entêtes.

Le fichier joint contient un exemple pour lire l'entête d'un document composé de deux sections.

Le code présent est celui-ci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub Test()
 
    LireEnTeteDePage ActiveDocument
 
End Sub
 
Sub LireEnTeteDePage(ByVal DocEncours As Document)
 
Dim sEc As Section
Dim I As Integer
 
    For I = 1 To DocEncours.Sections.Count
        With DocEncours.Sections(I).Headers(wdHeaderFooterPrimary)
             MsgBox "En tête section " & I & " : " & .Range.Text
             Debug.Print "En tête section : " & I & " : " & .Range.Text
        End With
    Next I
 
End Sub

09/01/2018, 16h18
christo0

https://wordmvp.com/FAQs/Customizati...ceAnywhere.htm

Voila un sujet qui traite de ma problématique, mais je n'arrive pas à l'adapter à ma macro

Citation:

Envoyé par christo0

Quand tu insères ce code, est-ce bien sur cette chaîne que doit porter la recherche ?

Code:

1
2
3
4
5
6
7
8
9
 
    With Wdoc.Sections(1)
         If .Headers.Count > 0 Then
             .Headers(wdHeaderFooterPrimary).Range.Select
             With WApp.Selection
                  MsgBox .Range.Text
             End With
         End If
     End With

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Explicit
 
' ----------------------------------------------------------------
' Extraction des données à partir de fichier Word vers Excel
' Par : Grand Chaman Excel -- 2013/03/05
'-----------------------------------------------------------------
Sub Importation_Donnees_Word()

    ' -- Déclaration des variables
    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
    Dim I As Integer
    Dim MaVariable As String
    
    ' -- Initialisation des variables
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)                       'on sauvegarde dans la 1re feuille
    sChemin = ".... .... ...."         '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
    
    MaVariable = InputBox("Veuillez renseigner le rang de la pièce concernée svp", "Titre", "XX")
    
    sNomFichier = Dir(sChemin & "*" & MaVariable & "*.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
        WApp.Selection.Find.Execute "n° PV"    'On trouve le texte "No Facture"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(I, 2) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par 2 ":"
        
        
        
        ' Ref du produit (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
        WApp.Selection.Find.Execute "Référence fab"    'On trouve le texte "CR"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(I, 3) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
        
        
        
        With WDoc.Sections(1)
         If .Headers.Count > 0 Then
             .Headers(wdHeaderFooterPrimary).Range.Select
             With WApp.Selection
                  
      ' Ref du produit (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
        WApp.Selection.Find.Execute "Réference"    'On trouve le texte "CR"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(I, 4) = Trim(Split(WSel, " ")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
        

    
        ' Ref du produit (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
        WApp.Selection.Find.Execute "n° DE SERIE"    'On trouve le texte "CR"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
        Set WSel = WApp.Selection                   'sélection du texte trouvé
        ws.Cells(I, 5) = Trim(Split(WSel, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
        
              End With
          End If
        End With
         
        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

Donc j'ai réussi finalement, avec votre aide, merci beaucoup :) j'avais juste besoin d'une nuit de sommeil pour trouver mes bugs.

Maintenance, je souhaite pouvoir selectionner Toute la ligne qui suit ma recherche, comment est-ce possible ?

J'ai constaté que en modifiant le chiffre 1 dans le code suivant, je décale le mot selectionné, mais la je souhaite selectionner la ligne entière qui suit mon mot clef de recherche.

Code:

ws.Cells(I, 5) = Trim(Split(WSel, ":")(1))

Merci d'avance, en espèrant avoir été clair.

Citation:

Envoyé par christo0

Il faudrait expliquer ce que vous devez trouver sur la chaîne à traiter, je ne suis pas devin. Si c'est "n° DE SERIE", alors essayez de remplacer les lignes en rouge par :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
 
        With Wdoc.Sections(1)
         If .Headers.Count > 0 Then
             .Headers(wdHeaderFooterPrimary).Range.Select
             With WApp.Selection
                  .Find.ClearFormatting         'on "vide la mémoire" de la fonction Recherche
                  .Find.Execute "n° DE SERIE"    'On trouve le texte "CR"
                  .MoveRight unit:=3, Count:=2, Extend:=2   'On se déplace de 3 mots
                 ' Set WSel = WApp.Selection                   'sélection du texte trouvé
                  ws.Cells(I, 5) = Trim(Split(WApp.Selection, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
             End With
          End If
        End With

10/01/2018, 10h07
christo0

Merci de votre interet, la partie en rouge fonctionne très bien, votre dernier code est certainement plus précis.

Je cherche maintenant à extraire toute la ligne contenant "n° DE SERIE", avec ce qu'il y a à sa droite et à sa gauche sur la ligne WORD.

Avez vous une idéee ?

Citation:

Envoyé par christo0

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
         With Wdoc.Sections(1)
         If .Headers.Count > 0 Then
             .Headers(wdHeaderFooterPrimary).Range.Select
             With WApp.Selection
                  .Find.ClearFormatting        
                  .Find.Execute "n° DE SERIE"  
                  .Expand wdLine
                  ws.Cells(I, 5) = Trim(Split(WApp.Selection, ":")(1))      'Le No de facture est la 2e chaîne de caractères séparés par ":"
             End With
          End If
        End With

10/01/2018, 11h13
christo0

Cela ne me copie pas l'integralité de la ligne dans mon fichier word, mais toujours qu'un seul mot ( celui qui suit celui de ma recherche)
10/01/2018, 11h42
Invité

Citation:

Envoyé par christo0

Mettez un fichier Word en ligne avec votre entête sans données confidentielles et indiquez moi ce que vous voulez récupérer.
10/01/2018, 13h35
christo0

Je ne peux vous faire parvenir de fichier.
11/01/2018, 05h03
Invité

Citation:

Envoyé par christo0

Il vous faut apprendre à utiliser l'aide en ligne de VBA Word !
Que vous indique l'aide pour le mot clé "Expand" ?
11/01/2018, 10h36
christo0

Code:

ws.Cells(I, 5).Value = WApp.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.Paragraphs.Item(6).Range.Text

Résolu, ce code active les entêtes du documents en 1ere page, et copie la ligne entière ( ici ligne 6) dans la cellule (I, 5).

Bonne journée