Discussion :

[guille37]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Invité]

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[guille37]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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")

[Invité]

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

Bonsoir,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[guille37]

Ok merci

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Quelqu'un à une solution?

[Invité]

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.