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

herve62

XLDnaute Barbatruc
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
VB:
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
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, herve62

Test OK sur mon PC (Excel et Word 2013)
VB:
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
 

Staple1600

XLDnaute Barbatruc
Re

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

herve62

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Re

On peut élaguer un chouia le code
(test OK sur Office 20103)
VB:
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
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas