Microsoft 365 Remplir tableau word avec cellules fusionnées avec excel VBA

MaMau · 30 Août 2021

Bonjour,
Je suis débutant en code VBA et j'ai un petit problème avec ma macro.
Je souhaite transférer des données Excel dans un tableau Word ( document Word déjà existant).
Le problème c'est que ces cellules sont fusionnées et que quand j'écris sa : "WordDoc.Tables(6).Columns(6).Rows(2).Range.Text = Range("H4") "
alors sa met "impossible d'accéder à des colonnes individuelles de cette collection car le tableau possède des cellules de largeurs différentes "

Alors du coup je sais pas comment faire pour remplir ce tableau Word par Excel. Pouvez vous m'aider ?

job75 · 31 Août 2021

Il n'est pas trop difficile d'adapter la macro :

Code:

Sub Word()
Dim Wapp As Object, Wdoc As Object, i&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
If Wdoc Is Nothing Then MsgBox "Doc Word.docx introuvable !", 48: Exit Sub
Wdoc.Tables(1).Cell(1, 4) = Cells(1, 1) 'décalage en ligne 1 à cause des cellules fusionnées
Wdoc.Tables(1).Cell(1, 5) = Cells(1, 2)
For i = 2 To 9 'nombre de lignes à adapter
    Wdoc.Tables(1).Cell(i, 5) = Cells(i, 1)
    Wdoc.Tables(1).Cell(i, 6) = Cells(i, 2)
Next
AppActivate Wapp.Caption
End Sub

job75 · 30 Août 2021

Bonjour MaMau, bienvenue sur XLD,

Les contenus des cellules fusionnées sont transférés sans problème dans Word.

Téléchargez les fichiers joints dans le même dossier et exécutez cette macro affectée au bouton :

VB:

Sub Word()
Dim Wapp As Object, Wdoc As Object
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
If Wdoc Is Nothing Then MsgBox "Doc Word.docx introuvable !", 48: Exit Sub
Wdoc.Tables(1).Cell(3, 2) = Range("B3") 'cellule fusionnée
Wdoc.Tables(1).Cell(4, 3) = Range("C4") 'cellule fusionnée
AppActivate Wapp.Caption
End Sub

A+

MaMau · 30 Août 2021

job75 à dit:
Bonjour MaMau, bienvenue sur XLD,

Les contenus des cellules fusionnées sont transférés sans problème dans Word.

Téléchargez les fichiers joints dans le même dossier et exécutez cette macro affectée au bouton :

VB:

Sub Word() Dim Wapp As Object, Wdoc As Object On Error Resume Next Set Wapp = GetObject(, "Word.Application") If Err Then Set Wapp = CreateObject("Word.Application") Wapp.Visible = True Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx") If Wdoc Is Nothing Then MsgBox "Doc Word.docx introuvable !", 48: Exit Sub Wdoc.Tables(1).Cell(3, 2) = Range("B3") 'cellule fusionnée Wdoc.Tables(1).Cell(4, 3) = Range("C4") 'cellule fusionnée AppActivate Wapp.Caption End Sub

A+

D'accord Merci je vais le tester

MaMau · 30 Août 2021

Bonjour,

J'avais une autre demande aussi. Dans un document word il faut signer 3 fois à un certain endroit.
Avec du VBA, peut on signer un doc word à partir d'un excel ? Si oui , comment fait-on?

Merci, d'avance

job75 · 30 Août 2021

MaMau à dit:
J'avais une autre demande aussi.

Un fil => une question.

Et d'abord qu'en est-il de ma réponse au post #1 ?

MaMau · 31 Août 2021

job75 à dit:
Un fil => une question.

Et d'abord qu'en est-il de ma réponse au post #1 ?

Alors j'ai essayé sa à l'air de marcher . Le seul problème c'est que sa me met pas le texte du excel dans le word

ca c'est mon excel et je dois le mettre sur un word enfin les données à l'intérieur sauf que sa me le met pas

job75 · 31 Août 2021

Dans Word il faut au moins un tableau, adaptez le code pour remplir les bonnes cellules.

MaMau · 31 Août 2021

Oui justement c'est ce que j'ai fais mais cela bloque
Sur word voici le debut du tableau :

job75 · 31 Août 2021

Il n'est pas trop difficile d'adapter la macro :

Code:

Sub Word()
Dim Wapp As Object, Wdoc As Object, i&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
If Wdoc Is Nothing Then MsgBox "Doc Word.docx introuvable !", 48: Exit Sub
Wdoc.Tables(1).Cell(1, 4) = Cells(1, 1) 'décalage en ligne 1 à cause des cellules fusionnées
Wdoc.Tables(1).Cell(1, 5) = Cells(1, 2)
For i = 2 To 9 'nombre de lignes à adapter
    Wdoc.Tables(1).Cell(i, 5) = Cells(i, 1)
    Wdoc.Tables(1).Cell(i, 6) = Cells(i, 2)
Next
AppActivate Wapp.Caption
End Sub

MaMau · 1 Septembre 2021

job75 à dit:

Il n'est pas trop difficile d'adapter la macro :

Code:

Sub Word()
Dim Wapp As Object, Wdoc As Object, i&
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Err Then Set Wapp = CreateObject("Word.Application")
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
If Wdoc Is Nothing Then MsgBox "Doc Word.docx introuvable !", 48: Exit Sub
Wdoc.Tables(1).Cell(1, 4) = Cells(1, 1) 'décalage en ligne 1 à cause des cellules fusionnées
Wdoc.Tables(1).Cell(1, 5) = Cells(1, 2)
For i = 2 To 9 'nombre de lignes à adapter
    Wdoc.Tables(1).Cell(i, 5) = Cells(i, 1)
    Wdoc.Tables(1).Cell(i, 6) = Cells(i, 2)
Next
AppActivate Wapp.Caption
End Sub

Merci beaucoup j'ai réajusté , ça à marché !!!!!

Microsoft 365 Remplir tableau word avec cellules fusionnées avec excel VBA

MaMau

XLDnaute Nouveau

job75

job75

XLDnaute Barbatruc

Pièces jointes

MaMau

XLDnaute Nouveau

MaMau

XLDnaute Nouveau

job75

XLDnaute Barbatruc

MaMau

XLDnaute Nouveau

job75

XLDnaute Barbatruc

MaMau

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

MaMau

XLDnaute Nouveau

Discussions similaires