Fusionner des fichiers Word en vba Excel

Version imprimable

Bonjour à tous,

Tous est dans le titre, enfin presque.

J'ai un fichier Excel avec une liste d'articles, à chaque article correspond un fichier Word (avec mise en page, titre avec hiérarchisation, style de texte...), j'ai l'adresse du fichier Word de renseigné dans mon fichier Excel.

Je souhaiterais créer un nouveau document Word avec les fichiers Word de chaque article mis les un à la suite des autres.

Je sais démarrer Word, ouvrir un fichier, enregistrer, récupérer le texte des paragraphes... via le VBA de Excel. Mais ca ne me garde pas la mise en forme de mon fichier Word d'origine...

Ce qu'il me manque (je crois), c'est simplement un copier tous du fichier Word d'un article et le coller à la fin d'un autre fichier Word.

Idéalement j'aimerais récupérer le contenu sans ouvrir les fichiers Word des articles.

j'ai bien trouver ça, mais je n'arrive pas à l'adapter pour faire un copier/coller :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Sub importLignesDocumentWord() Dim Fichier As String, Direction As String Dim wordApp As Word.Application Dim wordDoc As Word.Document Dim i As Byte Dim j As Integer Application.ScreenUpdating = False Direction = ThisWorkbook.Path Fichier = Dir(Direction & "\*.doc") Do While Fichier <> "" 'boucle sur tous les fichiers .doc du repertoire Set wordApp = CreateObject("Word.Application") wordApp.Visible = False Set wordDoc = wordApp.Documents.Open(Direction & "\" & Fichier) 'ouverture documents word j = j + 1 For i = 1 To wordDoc.Sentences.Count 'boucle sur les phrases/lignes de chaque document Cells(j, i) = _ Application.WorksheetFunction.Substitute(wordDoc.Sentences(i).Text, Chr(13), "") Next i wordDoc.Close False 'fermeture documents word wordApp.Quit Set wordDoc = Nothing Set wordApp = Nothing Fichier = Dir Loop End Sub
Je vous remercie d'avance

Guille

30/12/2016, 16h13
Invité

Citation:

Envoyé par guille37

Bonjour,

Après avoir ouvert une session Word pour l'ensemble des documents et créé un nouveau document avec :

Code:

Set WordDoc = WordApp.Documents.Add

Regardez du côté de la méthode InsertFile qui doit être insérée dans votre boucle Do While :

Code:

MaSelection.InsertFile Filename:=MonCheminComplet, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False

Où MaSelection est une variable Word.Selection du document créé, sinon Word ne va pas savoir à quel document se rapporte la sélection.

Pensez à sauvegarder votre fichier avant de quitter Word.

Pour comprendre le fonctionnement, regardez cet exemple de concaténation de fichiers .dat en VBA Word à la fin de cette discussion ouvrir-fichier-caracteres-variables

Cordialement.

Effectivement j'arrive à m'en sortir avec la fonction .InsertFile

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub FusionDocumentWord()
Dim Fichier As String, Direction As String
Dim FichierCompil As String
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim wordDocFus As Word.Document
 
Dim i As Byte
Dim j As Integer
 
Application.ScreenUpdating = False
 
Direction = ThisWorkbook.Path
Fichier = Dir(Direction & "\*.doc")
FichierCompil = Direction & "\Compil.doc"
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
Set wordDocFus = wordApp.Documents.Add 'Nouveau documents word
 
Do While Fichier <> "" 'boucle sur tous les fichiers .doc du repertoire
    wordApp.Selection.InsertFile Filename:=Direction & "\" & Fichier, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
    Fichier = Dir
Loop
 
wordDocFus.SaveAs FichierCompil
wordDocFus.Close
Set wordDocFus = Nothing
Set wordApp = Nothing
 
End Sub

Merci de ton aide

Encore une question pour comprendre ...
Peux-tu m'éclairer un peu sur les fonctions de la ligne 14 et la ligne 22 (l'utilisation de "Dir")

Citation:

Envoyé par guille37

Peux-tu m'éclairer un peu sur les fonctions de la ligne 14 et la ligne 22 (l'utilisation de "Dir")

Bonsoir,

Code:

Fichier = Dir(Direction & "\*.doc")

En ligne 14 : Fichier correspond au premier fichier .doc présent dans le répertoire Direction.
En ligne 22 : Il correspond au fichier .doc suivant dans le même répertoire.

Pour comprendre, place un Msgbox par exemple dans la boucle :
Code:

1 2 3 4 5 6 Do While Fichier <> "" 'boucle sur tous les fichiers .doc du repertoire wordApp.Selection.InsertFile Filename:=Direction & "\" & Fichier, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False Msgbox Fichier Fichier = Dir Loop

Ok merci

donc si je comprend bien, une fois tous les fichiers .doc du répertoire passé la variable:

Code:

Fichier = Dir ' prend une valeur nul soit Fichier = ""

d'où la fin de la boucle!

Les lignes de code vu avant fonctionne très bien, mais un nouveau souci est arrivé...

Je veux en fait insérer mes fichier Word dans un autre. Mais le souci c'est qu'ils s'insèrent en début de mon fichier "Base" alors que je voudrais qu'ils se mettent à la fin.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Public Sub B_Creer()
Dim Fichier_extrait As String
Dim Fichier_Base As String
Dim LiGne As Double
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
 
'   Recherche la derniere ligne renseigné avec des fichiers
DerniereLigne = Range("L65536").End(xlUp).Row
 
'   Fichier de départ
Fichier_Base = Cells(10, "L").Value
 
'   Vérifi si le fichier de base est déjà ouvert
 On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    Set wordDoc = wordApp.Documents(Fichier_Base)
    On Error GoTo 0
 
'   Ouvre le fichier de base si il est fermé
If wordDoc Is Nothing Then
    'ouvre session word
    Set wordApp = New Word.Application
    'ouvre fichier base word
    Set wordDoc = wordApp.Documents.Open(Fichier_Base)
    End If
wordApp.Visible = True
'wordApp.Activate
 
'   boucle de la ligne 11 à la derniere pour voir si un fichier Word es associer ou pas
For LiGne = 11 To DerniereLigne
If Cells(LiGne, "L") <> "" Then
    wordApp.Selection.EndKey Unit:=wdStory
    wordApp.Selection.InsertFile Filename:=Cells(LiGne, "L"), Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
    End If
Next LiGne
 
wordDoc.SaveAs ("D:\Bases\Test.docx")
wordDoc.Close    'Ferme le fichier
wordApp.Quit    'Ferme Word
Set wordDoc = Nothing
Set wordApp = Nothing
 
End Sub

J'ai beau mettre la ligne 33 rien ne se passe quand elle est exécuté par Excel.

Alors que si je met ce code dans Word directement la macro fonctionne...

Code:

1
2
3
4
5
Sub Macro2()
 
    Selection.EndKey Unit:=wdStory
 
End Sub

Quelqu'un à une solution?

03/01/2017, 14h18
Invité

Citation:

Envoyé par guille37

Bonjour,

Oui, je l'ai constaté aussi, d'où ma première réponse. Il te faut créer une variable MaSelection en tant que Word.Selection et avec un Set l'affecter à ton document de concaténation.

Cordialement.

Effectivement en ajoutant une variable sur la selection ça fonctionne!

Code:

1
2
3
4
5
6
7
'   boucle de la ligne 11 à la derniere pour voir si un extrait de CCPT existe ou pas
Set MaSelection = wordApp.Selection
For LiGne = 11 To DerniereLigne
If Cells(LiGne, "L") <> "" Then
    MaSelection.EndKey Unit:=wdStory
    MaSelection.InsertFile Filename:=Cells(LiGne, "L"), Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
    End If

Merci pour ton aide.