[RESOLU] Copier un tableau excel dans l'en-tete de word en vba

lechti31

XLDnaute Occasionnel
Bonsoir
J'aimerai faire un copier coller d'un tableau excel dans l'en-tete d'un fichier word en vba
Ci joint mon fichier
J'ai trouve un morceau de code mais ca plante
Merci pour votre aide
 

Pièces jointes

  • essais copier coller dans en-tete word.xlsm
    15.4 KB · Affichages: 38

Dranreb

XLDnaute Barbatruc
Bonjour.
Mettez Option Explicit en tête de vos modules.
Pourquoi cette procédure est-elle dans un module d'objet Worksheet ?
La bibliothèque Word n'a pas été associée au projet VBA, et vous ne pouvez donc pas déclarer de variables de types lui étant membres.
Pour l'associer vous devez cocher une référence Microsoft Word xx.x Object Library
Ce faisant il ne devrait plus être nécessaire d'utiliser CreateObject("Word.Application"), New Word.Application devrait suffire.
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum


Test OK (sur Excel 2013 et Word 2013 )avec le code ci-dessous
(Comme le dit Dranreb, code VBA mis dans un module standard)
VB:
Sub EnteteWord()
Dim strPath$, SrcePath$, Fichier$
strPath = ThisWorkbook.Path & "\"
Fichier = strPath & "Essai.docx"
'ici adapter le nom de la feuille (ici c'est le codename) et la plage de cellule
RangeToJPG Feuil2, "E6:J12", strPath & "Tableau.jpg"
SrcePath = strPath & "Tableau.jpg"
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(Fichier)
WordDoc.Sections(1).Headers(1).Range.InlineShapes.AddPicture SrcePath
End Sub
Private Sub RangeToJPG(WKS As Worksheet, Adresse As String, NomImage As String)
Dim Graf As Chart
With WKS.Range(Adresse)
.CopyPicture 1, -4147
Set Graf = WKS.ChartObjects.Add(10, 10, .Width, .Height).Chart
End With
Graf.Paste: Graf.ChartArea.Border.LineStyle = 0
On Error Resume Next
Kill NomImage
On Error GoTo 0
Graf.Export NomImage, "jpg": Graf.Parent.Delete
End Sub

PS: Petit recyclage d'un de mes anciens posts
https://www.excel-downloads.com/threads/resolu-export-plage-en-jpg.20011582/#post-20087147
 

lechti31

XLDnaute Occasionnel
Merci ca fonctionne, mais je ne peux plus modifier l'en-tete, ce que j'aimerai c'est pouvoir modifier l'en-tete sur le document word
Trouvez ci joint deux fichiers un word et un excel
Sur le word, j'ai une en-tete définie qui sera rempli par VBA via le fichier excel
Sur le fichier excel j'ai sur la feuille tampon les infos que je souhaite coller dans l'en-tete du fichier word
Donc la cellule D2 dois etre mise dans l'en-tete du document word dans la case 1 et ainsi de suite
Merci pour votre aide
 

Pièces jointes

  • essais.zip
    25.9 KB · Affichages: 31

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@lechti31
Je te laisse tester et adapter selon la structure de tes documents
(test OK sur mon PC)
Je t'ai mis deux exemples distincts pour remplir l'entête à partir d'Excel.
VB:
Sub EnteteWord_BIS() 
Dim strPath$, SrcePath$, Fichier$ 
strPath = ThisWorkbook.Path & "\": Fichier = strPath & "Essai.docx" 
Set WordApp = CreateObject("Word.Application"): WordApp.Visible = True 
Set WordDoc = WordApp.Documents.Open(Fichier) 
Sheets(1).Range("A1:C2").Copy 
'un tableau est déjà créé dans l'entête de Word 
With WordDoc.Sections(1).Headers(1).Range.Tables(1) 
.Cell(1, 1).Range.Text = Sheets(1).Range("A1") 
.Cell(1, 2).Range.Text = Sheets(1).Range("B1") 
.Cell(1, 3).Range.Text = Sheets(1).Range("C1") 
.Cell(2, 1).Range.Text = Sheets(1).Range("A2") 
.Cell(2, 2).Range.Text = Sheets(1).Range("B2") 
.Cell(2, 3).Range.Text = Sheets(1).Range("C2") 
End With 
End Sub 
Sub EnteteWord_TER() 
Dim strPath$, SrcePath$, Fichier$ 
strPath = ThisWorkbook.Path & "\": Fichier = strPath & "Essai.docx" 
Application.ScreenUpdating = False 
Set WordApp = CreateObject("Word.Application"): WordApp.Visible = False 
Set WordDoc = WordApp.Documents.Open(Fichier) 
'suppression de l'entête existant 
WordDoc.Sections(1).Headers(1).Range.Delete 
'copie de la plage Excel 
Sheets(1).Range("A1:C2").Copy 
WordDoc.Sections(1).Headers(1).Range.PasteExcelTable LinkedToExcel:=0, WordFormatting:=0, RTF:=-1 
Application.CutCopyMode = False 
WordDoc.Close True 
WordApp.Quit 
Set WordApp = Nothing 
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 754
Membres
101 812
dernier inscrit
trufu