Extraction de données depuis Word vers Excel

[benadry]

Bonjour,

J'ai trouvé sur ce site

 http://www.gcexcel.com/vba-importer-des-donnees-de-word-vers-excel/

une requête qui permet d'extraire automatiquement des données de nombreux documents Word vers Excel.

Elle fonctionne très bien, mais je n'arrive pas à l'adapter à mon cas particulier.

En effet,

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
        
    ' -- Initialisation des variables
    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
        If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect "titi"                       ' enlève le mot de passe du document Word
        End If
        Application.StatusBar = "Écriture ligne " & i       'message dans Excel pour voir la progression
        
        ' Nom du fichier
        ws.Cells(i, 1) = sNomFichier
        
        ' Date (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 "Date"    'On trouve le texte "Date"
        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é
        WApp.Selection.Copy
        ws.Cells(i, 2).Paste (xlPasteValues)            
         
       
    
        
        ' Numéro d'opérateur (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Numéro d'opérateur"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        WApp.Selection.Copy
        ws.Cells(i, 3).Paste (xlPasteValues)
        
        
        ' Montant anomalie (par la fonction FIND)
        WApp.Selection.HomeKey unit:=6
        WApp.Selection.Find.ClearFormatting
        WApp.Selection.Find.Execute "Montant anomalie"
        WApp.Selection.MoveRight unit:=3, Count:=2, Extend:=1
        Set WSel = WApp.Selection
        WApp.Selection.Copy
        ws.Cells(i, 4).Paste (xlPasteValues)
       
      
        i = i + 1                       'prochaine ligne
        WDoc.Close False                'fermer le document Word en l'enregistrant
        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

Apparemment, mon problème se situe au niveau de :

WApp.Selection.Copy
            ws.Cells(i, 4).Paste (xlPasteValues)

que j'ai mis moi-même, mais je ne sais pas comment faire pour que ça fonctionne.

Merci d'avance pour votre aide.


Cordialement.

 

[Guest]

Re : Extraction de données depuis Word vers Excel

Bonjour,

Pour retourner la date:

' Date (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 "Date"    'On trouve le texte "Date"
        WApp.Selection.Move unit:=wdWord, Count:=1 'On se déplace de 1 mot
        WApp.Selection.Expand unit:=wdWord ' et on étend la sélection au mot
       Set WSel = WApp.Selection              'sélection du texte trouvé
    
        ws.Cells(i, 2) = WSel.Text

A toi de tâtonner pour trouver les bons mouvements de sélection. L'aide VBA word te facilitera la tâche avec ses nombreux exemples.

Une fois que tu es certain te ta sélection Ws.Cells(i,2) = WSel.Text renverra le texte de la sélection dans la cellule.

Bon courage
A+

 

[benadry]

Re : Extraction de données depuis Word vers Excel

Bonjour hasco,
Bonjour le forum,

Je viens de tester et ça marche très bien !

Merci beaucoup.


Cordialement.