XL 2019 Incrementer donnees excel dans document word

[isohanne]

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

 

[Hasco]

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

 

[job75]

Bonjour isohanne, Roblochon,

Téléchargez les fichiers joints dans le même dossier (le bureau) et voyez cette macro :

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+

 

[isohanne]

Bonjour isohanne, Roblochon,

Téléchargez les fichiers joints dans le même dossier (le bureau) et voyez cette macro :

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 ?

 

[Hasco]

Bonjour,

@isohanne,

Avez-vue ma proposition du post #2 ?

Cordialement

 

[isohanne]

Bonjour,

@isohanne,

Avez-vue ma proposition du post #2 ?

Cordialement

Bonjour @Roblochon
Oui j'ai vu la proposition mais celle de votre dernier post convenait en tout point a ce que cherchais, mais je n'arrive pas à le mettre avec mon document actuel.

 

[Hasco]

mais celle de votre dernier post

Re,

Non, non dans le post #4 vous faisiez mention du #3 de @job75 qui repassera certainement par là 🙂.

Cordialement

 

[job75]

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]

Re,

Non, non dans le post #4 vous faisiez mention du #3 de @job75 qui repassera certainement par là 🙂.

Cordialement

Je viens de regarder mais tout n'est pas rempli dans le document word (tout le pavé "donnée de la mission jusqu'au signatures).

 

[isohanne]

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

 

[job75]

Merci, je dois m'absenter 1 heure ou 2, patientez.

 

[job75]

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

La nouvelle macro :

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

 

[isohanne]

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

La nouvelle macro :

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]

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