XL 2010 VBA fusion fichiers word garder le format [Resolu]

[herve62]

Bonjour
J'ai retrouvé une sub pour fusionner 2 fichiers word via le VBA sauf que le 1er mot du 2eme fichier se colle au dernier
du 1er fichier
Ce que j'aimerai c'est juste faire un "Add" des pages sans toucher au corps de texte : ex si FIC1= page 1 et 2 et FIC2 = page 1 après fusion
j'ai Fic = page 1 2 3

Sub fusiondoc()
Dim wrdApp As Object
Dim wrdDoc1 As Object
Dim wrdDoc2 As Object
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc1 = wrdApp.Documents.Open(ThisWorkbook.Path & "\blagues1.docx")
Set wrdDoc2 = wrdApp.Documents.Open(ThisWorkbook.Path & "\blagues2.docx")
wrdDoc1.Content.InsertAfter wrdDoc2.Content
wrdDoc1.SaveAs ThisWorkbook.Path & "\Blaguounettes.docx"
wrdApp.Quit
End Sub

 

[Staple1600]

Bonjour le fil, herve62

Test OK sur mon PC (Excel et Word 2013)

Sub fusiondoc_II()
Dim wrdApp As Object, wrdDoc1 As Object, strPath$, rng
strPath = ThisWorkbook.Path & "\"
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc1 = wrdApp.Documents.Open(strPath & "blagues1.docx")
Set rng = wrdDoc1.Range
With rng
  .Collapse 0
  .InsertBreak 2
  .End = wrdDoc1.Range.End
  .Collapse 0
  .InsertFile strPath & "blagues2.docx"
End With
wrdDoc1.SaveAs strPath & "Blaguounettes.docx"
wrdDoc1.Close True
wrdApp.Quit
End Sub

 

[herve62]

Merci JM , oui ok
D'ailleurs il me semble que la sub retrouvée devait venir de toi

 

[Staple1600]

Re

herve62
Bonne mémoire
Un truc vieux de 5 ans d'âge

https://www.excel-downloads.com/thr...r-word-avec-un-vba-excel.231240/#post-1474984

 

[herve62]

Oui je récupère mais souvent dans des anciens sujets , car avant de 'Poster' généralement je cherche ( pas comme certains ) ; là c'était dans une appli que j'ai faite l'an passé , hélas c'était pas le même besoin donc pas vu que le saut de page ne se faisait pas ; je maîtrise pas les instructions pour Word
Bon WE

 

[Staple1600]

Re

On peut élaguer un chouia le code
(test OK sur Office 20103)

Sub fusiondoc_III()
Dim wrdApp As Object, wrdDoc1 As Object, strPath$, rng
strPath = ThisWorkbook.Path & "\"
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc1 = wrdApp.Documents.Open(strPath & "blagues1.docx")
Set rng = wrdDoc1.Range
With rng: .Collapse 0: .InsertBreak 2: .InsertFile strPath & "blagues2.docx": End With
wrdDoc1.SaveAs strPath & "Blaguounettes2.docx": wrdDoc1.Close 0: wrdApp.Quit
End Sub