[RÉSOLU] Import champs word vers excel

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