Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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
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

XLDnaute Barbatruc
Vote positif 0 Vote négatif

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

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

XLDnaute Accro
Re
Je reviens encore une fois pour développer davantage (usine à gaz).
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

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

XLDnaute Accro
Bonsoir
Merci, Job, et je te souhaite une excellente nuit.
A+
 
Vote positif 0 Vote négatif

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

job75

XLDnaute Barbatruc
Ah mais on peut avec le même code mettre "Page 1/1" après l'image, c'est plus simple et plus logique.
 

Pièces jointes

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

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

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
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • 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
  • Résolu(e)
XL 2021 Copie de certaines données Excel sur Word
2
Réponses
28
Affichages
801
Mathos
M
  • Question
XL 2021 Création d'un document à partir d'un tableau
Réponses
6
Affichages
252
gbinforme
G
  • Résolu(e)
XL 2021 Copie cellules Excel vers Word avec mise à jour automatique
2
Réponses
29
Affichages
1 K
alexandre33260
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
820
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
583
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
396
sousou
H
  • Résolu(e)
Microsoft 365 Packing list automatisée
Réponses
10
Affichages
747
HugoLaChips
H
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…