Importer des champs Word dans Excel

Vous avez réalisé un formulaire sous Word ? Parfait... mais en toute logique vous n'avez pas envie de ressaisir tous les résultats dans Excel pour en tirer des statistiques.

Le petit boût de code VBA ci-dessous pourra vous aider. Ajoutez le dans une macro Excel et il vous permettra de copier le contenu de tous les champs de votre formulaire Word vers Excel. Sur la première ligne vous retrouverez le nom de vos champs Word.

Sub ImportWord()

Dim Wd As Word.Application
Dim filename As String
Dim i As Byte
    
    
    'On affiche la boite de dialogue pour sélectionner le fichier
    filename = Application.GetOpenFilename("Fichier Word (*.doc*),*.doc*", 1, "Sélectionnez un document Word", "Ouvrir", False)
    
    'On vérifie qu'un fichier a été sélectionné
    If filename <> "" Then
        filename = LCase(filename)
        'et qu'il s'agit d'un document word
        If Right(filename, 3) = "doc" Or Right(filename, 4) = "docx" Then
    
            'Créer une instance de word
            Set Wd = New Word.Application
            
            With Wd
                'Empêche Word de s'afficher à l'ouverture
                .Visible = False
                
                'Ouverture du document
                .documents.Open (filename)
                
                'Parcours de la collection de champs
                Dim f As Field
                For Each f In .ActiveDocument.Fields
                    'Nom du champs
                    Cells(1, f.Index).Value = .ActiveDocument.FormFields(f.Index).Name
                    
                    'Valeur du champs si case à cocher
                    If f.Type = 71 Then
                        Cells(2, f.Index).Value = .ActiveDocument.FormFields(f.Index).CheckBox.Value
                    Else 'autres champs
                        Cells(2, f.Index).Value = f.Result.Text
                    End If
                Next
                
                'Ferme le document Word
                .Quit False
            End With
            
            'Destruction de l'objet word
            Set Wd = Nothing
        End If
    End If

End Sub