XL 2013 (RESOLU) Automatisation de la Saisie de Données Excel vers un Document Word Modèle

chaelie2015

chaelie2015

XLDnaute Accro
Bonsoir Forum
J'ai un fichier Word que j'utilise comme modèle de document, appelé, "Charlie doc type". Dans ce document, il y a un texte qui comprend plusieurs contrôles de contenu de texte enrichi que j'ai nommés comme suit : "Champs_Nom" (il y en a trois), "Champs_Prénom" (il y en a trois également), et "Champs_Date" (il y en a trois aussi).

Par ailleurs, j'ai un fichier Excel (Feuille1) qui contient un tableau avec deux colonnes (A et B) et quatre lignes. La première ligne contient les en-têtes du tableau. Plus précisément,

je souhaite que les valeurs saisies dans les cellules du tableau A1:B4 de ce fichier Excel soient automatiquement renseignées dans les contrôles de contenu correspondants du document Word. Pour être plus précis, la cellule B2 du tableau Excel contient le nom, la cellule B3 contient le prénom, et la cellule B4 contient une date que je souhaite transmettre au document Word.
Merci
 

Pièces jointes

  • Charlie doc type.docx
    18.8 KB · Affichages: 15
  • Charlie Excel vers Word.xlsx
    11.6 KB · Affichages: 16
Dernière édition:
Solution
job75
En fait pour traiter votre pied de page ce n'est pas très compliqué :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
For Each c In Wdoc.Sections(1).Footers(1).Range.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
Wdoc.Sections(1).Footers(1).Range.Text = Replace(Wdoc.Sections(1).Footers(1).Range.Text...
Trier par date Trier par votes
mromain

mromain

XLDnaute Barbatruc
Vote positif 0 Vote négatif
chaelie2015

chaelie2015

XLDnaute Accro
Re
Désolé voici les bons fichiers.
NB: Il existe deux boutons, l'un pour le code de job75 et l'autre pour le code que vous avez proposé.
A+
 

Pièces jointes

  • Charlie doc type.docx
    24.7 KB · Affichages: 0
  • Charlie Excel vers Word.xlsm
    27.1 KB · Affichages: 0
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
En fait pour traiter votre pied de page ce n'est pas très compliqué :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
For Each c In Wdoc.Sections(1).Footers(1).Range.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
Wdoc.Sections(1).Footers(1).Range.Text = Replace(Wdoc.Sections(1).Footers(1).Range.Text, "Page", vbLf & vbTab & "Page") 'cadre Page 1/1
Err = 0
Wdoc.SaveAs ThisWorkbook.Path & "\" & Range("B2") & " " & Format(Range("B4"), "dd mm yyyy") & ".docx"
If Err = 0 Then
    For n = Wdoc.ContentControls.Count To 1 Step -1
        Wdoc.ContentControls(n).Delete
    Next
    For n = Wdoc.Sections(1).Footers(1).Range.ContentControls.Count To 1 Step -1
        Wdoc.Sections(1).Footers(1).Range.ContentControls(n).Delete
    Next
End If
AppActivate Wapp.Caption
End Sub
 

Pièces jointes

  • Charlie doc type.docx
    22 KB · Affichages: 7
  • Charlie Excel vers Word.xlsm
    21.2 KB · Affichages: 4
Vote positif 0 Vote négatif
Solution
chaelie2015

chaelie2015

XLDnaute Accro
Re
Je reviens encore une fois pour développer davantage (usine à gaz);):D.
Dans le pied de page du document Word, en plus du texte que je ne souhaite pas supprimer, il y a également une image (logo) que je veux conserver.
Merci par avance🙏
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Avec une image dans le pied de page il faut que le texte "Page 1/1" soit mis dans le contrôle de contenu :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, ncc&, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
ncc = Wdoc.Sections(1).Footers(1).Range.ContentControls.Count
For n = 1 To ncc
    Set c = Wdoc.Sections(1).Footers(1).Range.ContentControls(n)
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
    If n = ncc Then c.Range.Text = c.Range.Text & vbTab & "Page 1/1"
Next
Err = 0
Wdoc.SaveAs ThisWorkbook.Path & "\" & Range("B2") & " " & Format(Range("B4"), "dd mm yyyy") & ".docx"
If Err = 0 Then
    For n = Wdoc.ContentControls.Count To 1 Step -1
        Wdoc.ContentControls(n).Delete
    Next
    For n = ncc To 1 Step -1
        Wdoc.Sections(1).Footers(1).Range.ContentControls(n).Delete
    Next
End If
AppActivate Wapp.Caption
End Sub
Bonne nuit.
 

Pièces jointes

  • Charlie doc type.docx
    33.8 KB · Affichages: 3
  • Charlie Excel vers Word.xlsm
    21.6 KB · Affichages: 3
Vote positif 0 Vote négatif
chaelie2015

chaelie2015

XLDnaute Accro
job75 à dit:
Avec une image dans le pied de page il faut que le texte "Page 1/1" soit mis dans le contrôle de contenu :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, ncc&, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
ncc = Wdoc.Sections(1).Footers(1).Range.ContentControls.Count
For n = 1 To ncc
    Set c = Wdoc.Sections(1).Footers(1).Range.ContentControls(n)
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
    If n = ncc Then c.Range.Text = c.Range.Text & vbTab & "Page 1/1"
Next
Err = 0
Wdoc.SaveAs ThisWorkbook.Path & "\" & Range("B2") & " " & Format(Range("B4"), "dd mm yyyy") & ".docx"
If Err = 0 Then
    For n = Wdoc.ContentControls.Count To 1 Step -1
        Wdoc.ContentControls(n).Delete
    Next
    For n = ncc To 1 Step -1
        Wdoc.Sections(1).Footers(1).Range.ContentControls(n).Delete
    Next
End If
AppActivate Wapp.Caption
End Sub
Bonne nuit.
Cliquez pour agrandir...
Bonsoir
Merci, Job, et je te souhaite une excellente nuit.
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour chaelie2015, le forum,

On peut aussi ne pas se casser la tête et mettre "Page 1/1" au début du pied de page :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
For Each c In Wdoc.Sections(1).Footers(1).Range.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
Err = 0
Wdoc.SaveAs ThisWorkbook.Path & "\" & Range("B2") & " " & Format(Range("B4"), "dd mm yyyy") & ".docx"
If Err = 0 Then
    For n = Wdoc.ContentControls.Count To 1 Step -1
        Wdoc.ContentControls(n).Delete
    Next
    For n = Wdoc.Sections(1).Footers(1).Range.ContentControls.Count To 1 Step -1
        Wdoc.Sections(1).Footers(1).Range.ContentControls(n).Delete
    Next
End If
AppActivate Wapp.Caption
End Sub
A+
 

Pièces jointes

  • Charlie doc type.docx
    30 KB · Affichages: 1
  • Charlie Excel vers Word.xlsm
    21.4 KB · Affichages: 1
Vote positif 0 Vote négatif
chaelie2015

chaelie2015

XLDnaute Accro
Bonjour JOB,

Je vous remercie pour les différentes propositions très utiles. Cependant, en ce qui concerne le PV ou le compte rendu, il peut parfois s'étendre sur plus d'une page, c'est-à-dire que le contenu peut s'étaler du 1/4 jusqu'au 4/4. C'est pourquoi j'ai ajouté des champs de numérotation de pages dans les pieds de page, afin d'indiquer la page actuelle par rapport au nombre total de pages du document. Merci de prendre en considération ces remarques par rapport à la numérotation des pages.
NB: Il s'agit d'un pied de page interactif comprenant un texte statique (PV n°___), un champ de date automatique ('yyyy'), un élément de contrôle de contenu (qui est au cœur de notre préoccupation), des champs de numérotation des pages (indiquant la page actuelle par rapport au nombre total de pages), ainsi qu'une image du logo.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Dans le document Word joint j'ai créé 2 sections/pages.

j'ai pu obtenir la numérotation "Page 1/2" et "Page 2/2".

La macro modifiée pour traiter toutes les sections :
VB: 
Sub Word()
Dim Wapp As Object, Wdoc As Object, c As Object, ns&, n&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Charlie doc type.docx")
For Each c In Wdoc.ContentControls
    c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next
For ns = 1 To Wdoc.Sections.Count
    For Each c In Wdoc.Sections(ns).Footers(1).Range.ContentControls
        c.Range.Text = Format(Application.VLookup(c.Title, Range("A2:B4"), 2, 0), "dd/mm/yyyy")
Next c, ns
Err = 0
Wdoc.SaveAs ThisWorkbook.Path & "\" & Range("B2") & " " & Format(Range("B4"), "dd mm yyyy") & ".docx"
If Err = 0 Then
    For n = Wdoc.ContentControls.Count To 1 Step -1
        Wdoc.ContentControls(n).Delete
    Next
    For ns = 1 To Wdoc.Sections.Count
        For n = Wdoc.Sections(ns).Footers(1).Range.ContentControls.Count To 1 Step -1
            Wdoc.Sections(ns).Footers(1).Range.ContentControls(n).Delete
    Next n, ns
End If
AppActivate Wapp.Caption
End Sub
Bonne nuit.
 

Pièces jointes

  • Charlie doc type.docx
    35.5 KB · Affichages: 6
  • Charlie Excel vers Word.xlsm
    22 KB · Affichages: 6
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 Masquer/Afficher une ligne de tableau Word en fonction de la valeur du contrôleur de contenu
2
Réponses
20
Affichages
1 K
chaelie2015
chaelie2015
Mathos
  • Résolu(e)
XL 2021 Copie de certaines données Excel sur Word
2
Réponses
28
Affichages
798
Mathos
Mathos
M
  • Question
XL 2021 Création d'un document à partir d'un tableau
Réponses
6
Affichages
251
gbinforme
G
alexandre33260
  • Résolu(e)
XL 2021 Copie cellules Excel vers Word avec mise à jour automatique
2
Réponses
29
Affichages
1 K
alexandre33260
alexandre33260
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
819
job75
job75
F
  • Question
XL 2016 Générer un rapport pdf depuis excel
2
Réponses
22
Affichages
2 K
fraux
F
J
  • Résolu(e)
XL 2019 Important : Nommer fichier grâce aux éléments de publipostage
Réponses
6
Affichages
582
JacquesO
J
T
  • Question
XL 2016 Preparer mon publipostage avant export
Réponses
0
Affichages
76
tuti
T
C
  • Question
Microsoft 365 Générer un document word via excel
Réponses
1
Affichages
395
sousou
sousou
H
  • Résolu(e)
Microsoft 365 Packing list automatisée
Réponses
10
Affichages
746
HugoLaChips
H

Membres actuellement en ligne

4 membres et 55 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 084
Membres
112 655
dernier inscrit
fannycordi