XL 2019 Incrementer donnees excel dans document word

isohanne

XLDnaute Nouveau
Bonjour

J'ai un fichier avec des données excel. Je voudrais mettre en dernière colonne une icône qui ouvrirait directement un fichier word rempli avec les données de la ligne.

Pouvez-vous m'aider ? Je n'y connais rien en macro, je ne sais pas comment faire.

J'ai cherché sur le forum mais je n'ai trouvé qui pourrait m'aider ou que je puisse faire par moi-même.

Merci
 

Pièces jointes

  • Doc word à incrémenter.docx
    11.7 KB · Affichages: 16
  • Tableau données.xlsx
    9.3 KB · Affichages: 7

Hasco

XLDnaute Barbatruc
Repose en paix
bonjour,

En principe, on fait le contraire, un publipostage vers des fichier à partir de work.

Mais bon, voici quelque chose qui fait ceque vous demandez mais à partir de lien hypertexte, plus facile à gérer qu'un bouton.

double-cliquez dans une cellule de la colonne 'Demande word à télécharger' , si le fichier existe dans le répertoire du classeur, un message vous demandera si vous voulez le re-créer, sinon il sera créé à partir d'un modele (également dans le répertoire du classeur) et enregistré. Dans la colonne sera créé un lien vers le fichier.

Vous trouverez dans le .zip joint, le fichier excel et le modèle à mettre dans le même dossier (.dotx )

Cordialement
 

Pièces jointes

  • isohanne.zip
    39.2 KB · Affichages: 11

job75

XLDnaute Barbatruc
Bonjour isohanne, Roblochon,

Téléchargez les fichiers joints dans le même dossier (le bureau) et voyez cette macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i&, Wapp As Object, Wdoc As Object, dat, n As Byte, p As Object, r As Object, x$
i = Target.Row
If i = 1 Then Exit Sub
Cancel = True
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 & "\Doc word à incrémenter.docx") 'à adapter
If Wdoc Is Nothing Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error GoTo 0
dat = Cells(i, 1)
If IsDate(dat) Then dat = CDate(dat)
For n = 1 To 5
    For Each p In Wdoc.Paragraphs
        Set r = p.Range
        If r Like Cells(1, n) & "*" Then
            x = Cells(1, n) & " : " & IIf(n = 1, dat, Cells(i, n))
            If n = 5 Then x = x & String(50, " ") & "Signature 1 : " & Cells(i, 6)
            r = x & vbCr
            Exit For
        End If
Next p, n
AppActivate Wapp.Caption 'affiche Word
End Sub
Elle se déclenche automatiquement quand on fait un double-clic sur une ligne de la feuille.

A+
 

Pièces jointes

  • Tableau données(1).xlsm
    19 KB · Affichages: 18
  • Doc word à incrémenter.docx
    11.7 KB · Affichages: 14

isohanne

XLDnaute Nouveau
Bonjour isohanne, Roblochon,

Téléchargez les fichiers joints dans le même dossier (le bureau) et voyez cette macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i&, Wapp As Object, Wdoc As Object, dat, n As Byte, p As Object, r As Object, x$
i = Target.Row
If i = 1 Then Exit Sub
Cancel = True
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 & "\Doc word à incrémenter.docx") 'à adapter
If Wdoc Is Nothing Then MsgBox "Document Word introuvable !", 48: Exit Sub
On Error GoTo 0
dat = Cells(i, 1)
If IsDate(dat) Then dat = CDate(dat)
For n = 1 To 5
    For Each p In Wdoc.Paragraphs
        Set r = p.Range
        If r Like Cells(1, n) & "*" Then
            x = Cells(1, n) & " : " & IIf(n = 1, dat, Cells(i, n))
            If n = 5 Then x = x & String(50, " ") & "Signature 1 : " & Cells(i, 6)
            r = x & vbCr
            Exit For
        End If
Next p, n
AppActivate Wapp.Caption 'affiche Word
End Sub
Elle se déclenche automatiquement quand on fait un double-clic sur une ligne de la feuille.

A+
Merci pour votre réponse.
Alors j'ai essayé de prendre ça pour mon "vrai" document mais je n'y arrive. Ci-joint le fichier word que j'ai à incrémenter avec le tableau excel. Pouvez-vous m'aider ?
 

Pièces jointes

  • Doc word à incrémenter.docx
    16.7 KB · Affichages: 5
  • Tableau données intérim v0.xlsm
    19.4 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour isohanne, Roblochon,

Avec le dernier fichier Word ça devient trop compliqué.

Créez à la place un fichier Excel semblable, ce n'est pas bien difficile.

Et déposez-le ici, je vous ferai ensuite la macro pour le transfert.

A+
 

isohanne

XLDnaute Nouveau
Bonjour isohanne, Roblochon,

Avec le dernier fichier Word ça devient trop compliqué.

Créez à la place un fichier Excel semblable, ce n'est pas bien difficile.

Et déposez-le ici, je vous ferai ensuite la macro pour le transfert.

A+
Bonjour @job75

Ci joint le fichier excel semblable au word. Merci pour votre aide
 

Pièces jointes

  • Demande interim v0.xlsx
    12.7 KB · Affichages: 4
  • Tableau données intérim v0.xlsm
    19.4 KB · Affichages: 6

job75

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

La nouvelle macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i&, chemin$, fichier$, col, ref, F As Worksheet, n As Byte, v As Variant
i = Target.Row
If i = 1 Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "Demande interim.xlsx") 'à adapter
If fichier = "" Then MsgBox "Fichier .xlsx introuvable !", 48: Exit Sub
col = Array(1, 3, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21)
ref = Array("B5", "B6", "B7", "G7", "D12", "C13", "B14", "C15", "B16", "G16", "B22", "B23", "E22", "E23", "G22", "G23", "I22", "i23")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
Set F = Workbooks.Open(chemin & fichier).Sheets(1)
For n = 0 To UBound(col)
    v = Cells(i, col(n))
    If IsDate(v) Then F.Range(ref(n)) = CDate(v) Else F.Range(ref(n)) = v
Next
End Sub
 

Pièces jointes

  • Tableau données intérim(2).xlsm
    21.8 KB · Affichages: 13
  • Demande interim.xlsx
    12.9 KB · Affichages: 12

isohanne

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

La nouvelle macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i&, chemin$, fichier$, col, ref, F As Worksheet, n As Byte, v As Variant
i = Target.Row
If i = 1 Then Exit Sub
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "Demande interim.xlsx") 'à adapter
If fichier = "" Then MsgBox "Fichier .xlsx introuvable !", 48: Exit Sub
col = Array(1, 3, 5, 6, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21)
ref = Array("B5", "B6", "B7", "G7", "D12", "C13", "B14", "C15", "B16", "G16", "B22", "B23", "E22", "E23", "G22", "G23", "I22", "i23")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
Set F = Workbooks.Open(chemin & fichier).Sheets(1)
For n = 0 To UBound(col)
    v = Cells(i, col(n))
    If IsDate(v) Then F.Range(ref(n)) = CDate(v) Else F.Range(ref(n)) = v
Next
End Sub
Super Merci beaucoup
 

sonia06

XLDnaute Nouveau
Bonjour

J'ai un fichier avec des données excel. Je voudrais mettre en dernière colonne une icône qui ouvrirait directement un fichier word rempli avec les données de la ligne.

Pouvez-vous m'aider ? Je n'y connais rien en macro, je ne sais pas comment faire.

J'ai cherché sur le forum mais je n'ai trouvé qui pourrait m'aider ou que je puisse faire par moi-même.

Merci
Bonjour, A la place de se compliquer la vie avec Word et Excel, je vous propose d'utiliser un logiciel spécialement conçu pour la rédaction du mémoire technique. Vous pouvez réutiliser vos données à volonté. www.marchesoft.com
 

Discussions similaires