Récupérer des informations de Word vers Excel

Question

J'ai un code qui me permet d'automatiser le remplissage de document word à partir d'Excel grâce à la création de contrôles de contenus ayant pour balise les mêmes informations que les en-tête de colonne. Je souhaite à présent inverser le sens en récupérant les données déjà présentes dans ces contôles de contenu directement sur une nouvelle ligne Excel mais je ne parviens parviens pas à trouver une solution fonctionnelle. Auriez-vous une idée svp? Voici le code orginal qui marche pour le remplissage d'Excel vers Word Sub remplissage_doc() Dim WordApp As Object, WordDoc As Object, ctrl As Object Dim nom_fichier As String Set WordApp = CreateObject("word.application") WordApp.Visible = True nom_fichier = CreateObject("Wscript.Shell").SpecialFolders("MyDocuments") & "\essai01.docx" Set WordDoc = WordApp.Documents.Open(nom_fichier) 'entête document For Each ctrl In WordDoc.Sections(1).Headers(1).Range.ContentControls GoSub remplissage_ctrl_text Next ctrl 'corps document For Each ctrl In WordDoc.ContentControls GoSub remplissage_ctrl_text Next ctrl 'sortie procédure Exit Sub remplissage_ctrl_text: If ctrl.Type = 0 Then Set cell = ActiveSheet.Rows(1).Find(ctrl.Tag) If Not cell Is Nothing Then ctrl.Range.Text = cell.Offset(ActiveCell.Row - 1) ctrl.Range.Font.ColorIndex = 2 'couleur bleue End If End If Return End Sub...

thev · Accepted Answer

Ci-dessous code modifié Sub Importation_donnees() Dim nom_fichier As String, fichier As Object Dim wdoc As Word.Document, ctrl_text As Word.ContentControl Dim cell As Range, ligne As Integer 'Affiche la boîte de dialogue "Ouvrir" nom_fichier = Application.GetOpenFilename("Tous les fichiers (*.doc*),") 'On sort si aucun fichier n'a été sélectionné ou si l'utilisateur 'a cliqué sur le bouton "Annuler", ou sur la croix de fermeture. If nom_fichier = "Faux" Or nom_fichier = Empty Then MsgBox "aucun fichier sélectionné": Exit Sub 'Assigne le fichier ouvert et vérifie que c'est un document Word Set fichier = GetObject(nom_fichier) If Not fichier.Application.Name Like "*Word" Then MsgBox "fichier ouvert non Word": fichier.Close: Exit Sub Set wdoc = fichier 'Première ligne vide de la feuille active ligne = ActiveSheet.Columns("A").Find("").Row 'Récupérer le texte dans les controles de contenu en recherchant dans l'en-tete du Fichier sélectionné 'les informations seront récupérées et rangées sur une meme ligne en suivant les en-tete de colonne For Each ctrl_text In wdoc.Sections(1).Headers(1).Range.ContentControls GoSub remplissage_feuille Next ctrl_text 'Récupérer le texte dans les controles de contenu en recherchant dans le corps du Fichier selectionné 'les informations seront récupérées et rangées sur une meme ligne en suivant les en-tete de colonne For Each ctrl_text In wdoc.ContentControls GoSub remplissage_feuille Next ctrl_text 'fermeture application Word et sortie procédure wdoc.Application.Quit Exit Sub remplissage_feuille: If ctrl_text.Type = 0 Then Set cell = ActiveSheet.Rows(1).Find(ctrl_text.Tag) If Not cell Is Nothing Then Cells(ligne, cell.Column) = ctrl_text.Range.Text End If Return End Sub...

Invité · Answer

Avez-vous déjà entendu parler du "Publipostage" Vous avez des ces idées parfois...

thev · Answer

A mon avis, votre demande s'apparente à celle formulée par ArnaudLBRD, à savoir remplir par formulaire les champs d'un document Word et générer ce formulaire à partir des champs présents dans ce document. J'y ai apporté réponse dans ce post : https://forum.excel-pratique.com/excel/rechercher-charactere-dans-un-document-word-depuis-un-fichier.....

thev · Answer

Ci-jointe votre macro d'importation corrigée...