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

[MaMau]

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]

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 :

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]

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 :

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]

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]

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]

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]

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

 

[MaMau]

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

 

[job75]

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

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]

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

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