Automatiser le remplissage de dossier de lot depuis Excel

Bonjour,

Dans le cadre de mon travail, je souhaite automatiser le remplissage entre Word et Excel et d'après mes recherches et de nombreux essais infructueux avec les signets dans Word, j'opte pour cette nouvelle façon de faire que j'ai trouvé sur le forum.

Il faut donc utiliser des contrôles de contenu de texte : Word --> menu développeur --> Contrôles --> Bouton "Aa".

Les propriétés de ce contrôle comportent un titre et une balise. J'ai alors affecté les noms de la colonne B et ceci marche bien avec l'exemple fourni sur le forum.

Mais moi j'ai besoin d'automatiser le remplissage en fonction des lignes et non des colonnes. J'aimerais aussi que le remplissage du fichier word se fasse à partir des données contenues dans les cellules de la ligne active. J'ai vu que je pouvais utiliser la fonction ActiveCell.Row mais je ne nais pas comment l'inclure.

Je débute vraiment en programmation.

Quelqu'un peut-il m'aider à modifier le code SVP ?

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)

    For Each ctrl In WordDoc.ContentControls
        If ctrl.Type = 0 Then
            Set Cell = ActiveSheet.Columns("B").Find(ctrl.Tag)
            If Not Cell Is Nothing Then ctrl.Range.Text = Cell.Offset(, 1)
        End If
    Next ctrl

    MsgBox "fin du traitement"

    WordDoc.Close savechanges:=True
    WordApp.Quit
End Sub

Voici le fichier Word utilisé.

Merci d'avance.

Bonjour,

Vous pouvez essayer

Set cell = ActiveCell.EntireRow.Find(ctrl.Tag)

J'ai essayé et ça me rempli uniquement l'information devant la date par exemple et pas les autres.

La configuration de mon tableau est juste transposée par rapport au tableau dans l'exemple que vous avez déjà traité.

Les informations clés à renseigner par client sur la toute première ligne du tableur et la liste des clients en ordonnées.

J'ai introduis la ligne supplémentaire mais je reçois un message d'erreur.

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)

   For Each ctrl In WordDoc.ContentControls
        If ctrl.Type = 0 Then
Set cell = ActiveCell.EntireRow.Find(ctrl.Tag)
            Set cell = ActiveSheet.Row("1").Find(ctrl.Tag)
            If Not cell Is Nothing Then
                ctrl.Range.Text = cell.Offset(, 1)
                ctrl.Range.Font.ColorIndex = 2 'couleur bleue
            End If
        End If
    Next ctrl

End Sub

Je vous joint un fichier afin que vous comprenez exactement la structure.

Merci pour votre réactivité.

Bonjour,

Essayer ce code

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)

   For Each ctrl In WordDoc.ContentControls
        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
    Next ctrl

End Sub

Merci encore pour votre réponse.

Je ne pourrai réellement essayer ce nouveau code que le lundi prochain sur un système Windows au bureau.

Je vous ferai un retour très vite.

Bonjour et merci pour votre patience.

Je viens d'essayer le code et il marche parfaitement en remplissant tous les champs dans le corps du texte . Cependant, les champs à remplir au niveau de l'en-tête du document Word restent vide . Y a t'il un moyen de contourner ce problème ?

Je vous remercie.

Bonjour,

ci-dessous code

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

je viens d'essayer et tout fonctionne super bien.

Je ne vous remercierai jamais assez.

Merci pour votre réactivité.

Bonjour,

Cette discussion a été marquée comme résolue mais j'aimerais formuler une nouvelle demande qui rejoint la première.

Le code ci-dessus fonctionne très bien et me permet de créer automatiquement mes documents Word à partir d'Excel.

Par contre, j'aimerais savoir si le chemin inverse (Word --> Excel) est possible en modifiant légèrement le code. En effet, j'aimerais pouvoir importer directement sur une nouvelle ligne toutes les informations contenues dans les control content sur Word. J'ai cherché mais je ne trouve pas de solution concrète. Aurez-vous une idée SVP?

Merci