Lier des information d'un tableau excel a un word

Y

yohan60

XLDnaute Nouveau
Bonjour,

je souhaiterais liée certaines informations d'un tableau à un document word, avec mise à jour automatique après modif sachant q'une ligne est inséré au tableau a chaque nouvelle entrée donc c'est toujours la dernière ligne du tableau correspondent qui serait liée au word sélectionner, les infos du word doivent être liée au colonne du meme non sur le tableau excel.
j'aurais également besoin d'insérer sur le doc word une signature manuscrite automatiquement également.

es-ce fessable, quelq'un peut il m'aider?

a bientot et merci
 

Pièces jointes

  • essai protocole.docm
    15.3 KB · Affichages: 10
  • essai prtocole.xlsm
    68.2 KB · Affichages: 6
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Bonjour yohan60, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro dans la feuille "Acces_journaliers" du fichier .xlsm :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range, c As Range, chemin$, doc$, Wapp As Object, x$
If Target.Row < 8 Then Exit Sub
Cancel = True
Set P = Intersect(Target.EntireRow, [B:B,E:E,I:I,L:M,O:P])
Set c = P.Find("", P(1, 15), xlValues)
If Not c Is Nothing Then MsgBox "Toutes les cellules jaunes doivent être renseignées": c.Select: Exit Sub
If Not IsDate(P(1)) Then MsgBox "Date incorrecte": P(1).Select: Exit Sub
If Not IsNumeric(P(1, 8)) Then MsgBox "Heure incorrecte": P(1, 8).Select: Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
doc = "Modèle protocole.docx" 'à adapter
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
With Wapp.documents.Open(chemin & doc)
    .Bookmarks("Date").Range = P(1).Text
    .Bookmarks("Société").Range = P(1, 4)
    .Bookmarks("Heure").Range = P(1, 8).Text
    .Bookmarks("Code").Range = P(1, 11)
    .Bookmarks("Nature").Range = P(1, 12)
    .Bookmarks("Type").Range = P(1, 14)
    .Bookmarks("Conditionnement").Range = P(1, 15)
    x = P(1, 4) & Format(CDate(P(1)) + CDbl(P(1, 8)), " yyyy-mm-dd hhmmss") & ".docx"
    Wapp.documents(x).Close False 'si le document Word est ouvert on le ferme
    .SaveAs chemin & x
    If Wapp.documents.Count = 1 Then Wapp.Quit Else .Close False
    MsgBox "Le document '" & x & "' a été créé...", , "Word"
End With
End Sub
Elle s'exécute par double-clic dans le tableau.

A+
 

Pièces jointes

  • essai protocole(1).xlsm
    64.3 KB · Affichages: 4
  • Modèle protocole.docx
    15.5 KB · Affichages: 5
Dernière édition:
Vote positif 0 Vote négatif
Y

yohan60

XLDnaute Nouveau
job75 à dit:
Bonjour yohan60, le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro dans la feuille "Acces_journaliers" du fichier .xlsm :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim P As Range, c As Range, chemin$, doc$, Wapp As Object, x$
If Target.Row < 8 Then Exit Sub
Cancel = True
Set P = Intersect(Target.EntireRow, [B:B,E:E,I:I,L:M,O:P])
Set c = P.Find("", P(1, 15), xlValues)
If Not c Is Nothing Then MsgBox "Toutes les cellules jaunes doivent être renseignées": c.Select: Exit Sub
If Not IsDate(P(1)) Then MsgBox "Date incorrecte": P(1).Select: Exit Sub
If Not IsNumeric(P(1, 8)) Then MsgBox "Heure incorrecte": P(1, 8).Select: Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
doc = "Modèle protocole.docx" 'à adapter
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
With Wapp.documents.Open(chemin & doc)
    .Bookmarks("Date").Range = P(1).Text
    .Bookmarks("Société").Range = P(1, 4)
    .Bookmarks("Heure").Range = P(1, 8).Text
    .Bookmarks("Code").Range = P(1, 11)
    .Bookmarks("Nature").Range = P(1, 12)
    .Bookmarks("Type").Range = P(1, 14)
    .Bookmarks("Conditionnement").Range = P(1, 15)
    x = P(1, 4) & Format(CDate(P(1)) + CDbl(P(1, 8)), " yyyy-mm-dd hhmmss") & ".docx"
    Wapp.documents(x).Close False 'si le document Word est ouvert on le ferme
    .SaveAs chemin & x
    If Wapp.documents.Count = 1 Then Wapp.Quit Else .Close False
    MsgBox "Le document '" & x & "' a été créé...", , "Word"
End With
End Sub
Elle s'exécute par double-clic dans le tableau.

A+
Cliquez pour agrandir...
Bonjour,

je te remercie, au lieu d'un double click dans le tableau je souhaiterais cliquer sur un lien qui ouvre une autre page, avec des lien vers les différent doc word car il existe environ 12 protocoles de langues différente, que j'ouvrirais : anglais, allemand etc devra prendre les infos de la dernière ligne.
je ne trouvent pas le document qui est enregistré, et au lieu de le fermer est il possible de l'afficher à l'écran, car il devra être signer sans imprimer.

en te remerciant
 

Pièces jointes

  • Capture.JPG
    Capture.JPG
    20.4 KB · Affichages: 12
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Autre solution : il est beaucoup plus simple de rester sur le fichier Excel pour l'édition des protocoles.

Voyez ce fichier (2) et cette macro très simple :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&
With ListObjects(1).Range
    i = .Rows.Count
    ThisWorkbook.Names.Add "Date", .Cells(i, 2).Text
    .Cells(i, 5).Name = "Société"
    ThisWorkbook.Names.Add "Heure", "=""" & .Cells(i, 9).Text & """"
    .Cells(i, 12).Name = "Code"
    .Cells(i, 13).Name = "Nature"
    .Cells(i, 15).Name = "Type"
    .Cells(i, 16).Name = "Conditionnement"
    .Interior.ColorIndex = xlNone
    Union(.Cells(i, 2), .Cells(i, 5), .Cells(i, 9), .Cells(i, 12), .Cells(i, 13), .Cells(i, 15), .Cells(i, 16)).Interior.ColorIndex = 6
End With
End Sub
J'ai prévu des boutons pour la création de fichiers PDF mais c'est tout à fait facultatif :
VB: 
Sub PDF()
On Error Resume Next
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & _
    ActiveSheet.Name & " " & [Société] & Format(CDate([Date]) + CDate([Heure]), " yyyy-mm-dd hhmmss")
MsgBox IIf(Err, "Echec, voyez les données Date du jour et Heure d'entrée", "PDF créé")
End Sub
 

Pièces jointes

  • essai protocole(2).xlsm
    70.5 KB · Affichages: 16
Vote positif 0 Vote négatif
Y

yohan60

XLDnaute Nouveau
job75 à dit:
Autre solution : il est beaucoup plus simple de rester sur le fichier Excel pour l'édition des protocoles.

Voyez ce fichier (2) et cette macro très simple :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i&
With ListObjects(1).Range
    i = .Rows.Count
    ThisWorkbook.Names.Add "Date", .Cells(i, 2).Text
    .Cells(i, 5).Name = "Société"
    ThisWorkbook.Names.Add "Heure", "=""" & .Cells(i, 9).Text & """"
    .Cells(i, 12).Name = "Code"
    .Cells(i, 13).Name = "Nature"
    .Cells(i, 15).Name = "Type"
    .Cells(i, 16).Name = "Conditionnement"
    .Interior.ColorIndex = xlNone
    Union(.Cells(i, 2), .Cells(i, 5), .Cells(i, 9), .Cells(i, 12), .Cells(i, 13), .Cells(i, 15), .Cells(i, 16)).Interior.ColorIndex = 6
End With
End Sub
J'ai prévu des boutons pour la création de fichiers PDF mais c'est tout à fait facultatif :
VB: 
Sub PDF()
On Error Resume Next
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & _
    ActiveSheet.Name & " " & [Société] & Format(CDate([Date]) + CDate([Heure]), " yyyy-mm-dd hhmmss")
MsgBox IIf(Err, "Echec, voyez les données Date du jour et Heure d'entrée", "PDF créé")
End Sub
Cliquez pour agrandir...
Bonsoir merci encore, je vais prendre cette solution elle sera surement plus simple.
j'ai déja les doc word dans les différente langues.

quand je clique sur le bouton pdf, ou dois-je mettre le chemin pour sauvegarder le document.
merci d'avance

Yohan
 
Vote positif 0 Vote négatif
Y

yohan60

XLDnaute Nouveau
yohan60 à dit:
Bonsoir merci encore, je vais prendre cette solution elle sera surement plus simple.
j'ai déja les doc word dans les différente langues.

quand je clique sur le bouton pdf, ou dois-je mettre le chemin pour sauvegarder le document.
merci d'avance

Yohan
Cliquez pour agrandir...
Re, bonsoir,

Merci encore du travail que vous avez effectuer, cette solution est plus simple d'utilisation et je vais donc la conservé.
souhaiteriez vous voir le projet final, quand celui-ci sera terminer...
Yohan
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
310
job75
job75
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation de la Saisie de Données Excel vers un Document Word Modèle
2 3
Réponses
31
Affichages
2 K
job75
job75
S
  • Question
Microsoft 365 Pulbipostage Excel→Word : cases à cocher
Réponses
1
Affichages
114
Staple1600
Staple1600
G
  • Question
XL 2016 Lier un TCD et un tableau Excel
Réponses
7
Affichages
238
OKBI
O
C
  • Question
Microsoft 365 Copier des données d'un fichier excel sur un fichier word
Réponses
0
Affichages
740
ChristianJ
C
L
  • Question
Microsoft 365 Code VBA pour commencer publipostage à partir d'un .dotx
Réponses
5
Affichages
904
Law0179
L
R
  • Question
Microsoft 365 Excel : fonction SI
Réponses
5
Affichages
406
Rambo12
R
M
  • Question
Microsoft 365 Copier un tableau excel sur un document word existant-word.apps
Réponses
11
Affichages
1 K
M-1
M
J
  • Question
XL 2019 VBA Import d'un tableau Word sur Excel
Réponses
12
Affichages
3 K
Jérémy26
J
S
  • Question
Microsoft 365 Afficher dans un tableau les noms des feuilles d'un fichier excel ainsi que le nombre de lignes renseignées pour chacune d'elle.
Réponses
2
Affichages
359
chris
chris

Membres actuellement en ligne

18 membres et 378 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
312 185
Messages
2 086 018
Membres
103 094
dernier inscrit
Molinari