[VBA - W] fusion de documents word + garder les styles

[schuitonzo]

Bonjour,

J'ai sous la main un code qui me permet de fusionner plusieurs documents Word en un seul:

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Sub ConcatenateAllWordFiles()
Dim path As String
Dim Name As String
    path = "H:\User\Test" 'Just tell the user that he has to create a folder named "Test" in "My Documents", and put all word files we wants to merge in.
 
    ' sélection de l'ensemble des données du document actif
    ' selecting all datas from active document
    ActiveDocument.Content.Select
    Name = ActiveDocument.Name
 
    ' supprime toutes les données
    ' deleting all datas
    Selection.Delete
 
    ' définition d'un chercheur de fichiers
    ' defining a file searcher
    With Application.FileSearch
        ' reset de toutes les propriétés du chercheur
        ' resetting all properties from the file searcher
        .NewSearch
        ' liste tous les fichiers du dossier spécifié
        ' making a list of all files present in the folder
        .LookIn = path
        .SearchSubFolders = False 'Set this to false if you don't want subfolders included
        ' lance la recherche
        ' launching search
        .Execute
 
        ' boucle de parcours de tous les fichiers
        ' loop making a glance through all files
        For i = 1 To .FoundFiles.Count
            ' sélectionne uniquement les fichiers dont l'extension est .doc
            ' selecting .doc files only
            If Right(.FoundFiles(i), 4) = ".doc" Then
                ' suppression temporaire de l'update automatique des links (évite l'apparition d'un warning message à chaque ouverture d'un fichier doc)
                ' temporary delete of links' automatic update (in order to avoid the appearance of a warning message each time a .doc file is opened)
                Options.UpdateLinksAtOpen = False
                ' Application.ScreenUpdating = False
 
                ' ouverture du fichier sans le rendre visible
                ' opening the file without making him visible
                Documents.Open FileName:=.FoundFiles(i), Visible:=True, _
                ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatAuto
 
                current = ActiveDocument.Name
                ' sélection de l'ensemble des données du document
                ' selecting all datas from the document
                Selection.WholeStory
                ' copie de toutes les données
                ' copy of all datas
                Selection.Copy
                ' fermeture du document sans sauvegarde
                ' closing  the document without saving it
                Documents(current).Close (wdDoNotSaveChanges)
                ' colle toute les données sauvegardées dans le document compilé
                ' pasting all saved datas in the compiled document
                Selection.Paste
                Selection.EndKey Unit:=wdLine
                ' réactivation de l'option update automatique des liens
                ' reactivating links' automatic update option
                Options.UpdateLinksAtOpen = True
            End If
 
        Next i
 
    End With
    ' update général de toutes les données linkée
    ' general update of all linked datas
    ' Application.ScreenUpdating = True
    Documents.Open FileName:="Test.doc", ConfirmConversions:=False _
            , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
    ActiveDocument.Content.Select
    Selection.Fields.Update
 
End Sub

Je voudrais que les documents incorporent également les styles, et qu'il continue la numérotation comme dans le premier document.

Savez-vous comment procéder?

Merci d'avance pour votre aide

[ouskel'n'or]

Le problème est qu'un document peut avoir des styles définis par l'utilisateur. Si tu copies les données d'un tel document dans un document créé dans un autre, le style sera celui du document "receveur".
La solution consisterait
- à créer un nouveau document depuis le document à copier (Document.add)
- à copier le contenu du document à copier puis de fermer le document d'origine.
Ainsi, le style du nouveau document sera celui du document copié.
Pas testé sous la forme que tu indiques mais... victime du phénomène sur un document "très urgent" de 250 pages, finalisé, au moment de le donner à la reprographie... et dont j'ai dû reprendre toute la mise en page, la secrétaire ayant sauvegardé et l'original et la copie de sauvegarde
Tu peux tester pour nous ?

A+

[schuitonzo]

Le problème est que j'ai repris ce code du gars qui me précédait dans mon boulot et je suis pas du tout calé en vba, donc je vois pas trop où insérer quoi pour que ça marche

[ouskel'n'or]

Je t'ai fait ça

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Sub ConcatenateAllWordFiles()
Dim path As String
Dim Name As String
Dim NewDoc As Boolean
    NewDoc = False
    path = "H:\User\Test" 'Just tell the user that he has to create a folder named "Test" in "My Documents", and put all word files we wants to merge in.
    
    
    ' sélection de l'ensemble des données du document actif
    ' selecting all datas from active document
    ''ActiveDocument.Content.Select
    Name = ActiveDocument.Name
    
    ' supprime toutes les données
    ' deleting all datas
    ''Selection.Delete    
    ' définition d'un chercheur de fichiers
    ' defining a file searcher
    With Application.FileSearch
        ' reset de toutes les propriétés du chercheur
        ' resetting all properties from the file searcher
        .NewSearch
        ' liste tous les fichiers du dossier spécifié
        ' making a list of all files present in the folder
        .LookIn = path
        .SearchSubFolders = False 'Set this to false if you don't want subfolders included
        ' lance la recherche
        ' launching search
        .Execute
        
        ' boucle de parcours de tous les fichiers
        ' loop making a glance through all files
        For i = 1 To .FoundFiles.Count
            ' sélectionne uniquement les fichiers dont l'extension est .doc
            ' selecting .doc files only
            If Right(.FoundFiles(i), 4) = ".doc" Then
                ' suppression temporaire de l'update automatique des links (évite l'apparition d'un warning message à chaque ouverture d'un fichier doc)
                ' temporary delete of links' automatic update (in order to avoid the appearance of a warning message each time a .doc file is opened)
                Options.UpdateLinksAtOpen = False
                ' Application.ScreenUpdating = False
                
                ' ouverture du fichier sans le rendre visible
                ' opening the file without making him visible
                Documents.Open FileName:=.FoundFiles(i), Visible:=True, _
                ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
                PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
                WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
                wdOpenFormatAuto
                
                current = ActiveDocument.Name
                ' sélection de l'ensemble des données du document
                ' selecting all datas from the document
                
                If Not NewDoc Then 'Je ne crée un nouveau document au modèle que s'il n'existe pas

'Extrait de l'aide à "Documents.add"
'Cet exemple montre comment créer et ouvrir un document en utilisant le modèle attaché au document actif.
                    tmpName = ActiveDocument.AttachedTemplate.FullName
                    Documents.Add Template:=tmpName, NewTemplate:=True
                    NewDocName = ActiveDocument.Name
                    NewDoc = True ' On ne passe ici qu'une fois
                End If
                
                'Retour dans le document à copier
                Documents(current).Activate
                
                'Sélection de tout le document à copier
                Selection.WholeStory
                
                ' copie de toutes les données
                ' copy of all datas
                Selection.Copy
                
                'Retour dans le nouveau document
                Documents(NewDocName).Activate
                ' colle toute les données sauvegardées dans le document compilé
                ' pasting all saved datas in the compiled document
                Selection.Paste
                
                ' fermeture du document (copié) sans sauvegarde
                ' closing  the document without saving it
                Documents(current).Close (wdDoNotSaveChanges)
                
                'On va en fin du doc créé pour être en position de recevoir la nouvelle copie
                Selection.EndKey Unit:=wdLine
                
                ' réactivation de l'option update automatique des liens
                ' reactivating links' automatic update option
                Options.UpdateLinksAtOpen = True
            End If
            
        Next i
        
    End With
    
    ' update général de toutes les données linkée
    ' general update of all linked datas
    ' Application.ScreenUpdating = True
    Documents.Open FileName:="Test.doc", ConfirmConversions:=False _
            , ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
            PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
            WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
    ActiveDocument.Content.Select
    Selection.Fields.Update
    
End Sub

Ce que j'ai compris du code : Concaténer tous les documents contenus dans "H:\User\Test" (ouais, avec le nom de la macro j'aurais dû m'en douter...)
Ce que je t'ai fait : Créer un nouveau document au modèle du premier fichier ouvert dans ce répertoire, nouveau document dans lequel sont copiés tous les fichiers de ce même répertoire.
Tu dis
A+

NB - En rouge, code supprimé (je n'ai pas compris le sens de ''ActiveDocument.Content.Select" ici, j'aurais utilisé " Selection.WholeStory" d'ailleurs utilisé plus loin)

[eugiba]

Bonjour j'effectue un publipostage et je souhaite fusionner des documents "publipostés".

J'ai essayé votre code mais un erreur apparaît sur la ligne

Code :

Selection.WholeStory

Message d'erreur :
Erreur d'exécution '438':
Propriété ou méthode non gérée par cet objet.

Pouvez-vous m'aider s'il y a encore quelqu'un sur cette discussion ??

[Souriane]

eugiba, avez-vous trouvez votre réponse?

[carden752]

Bonjour,

Bonjour j'effectue un publipostage et je souhaite fusionner des documents "publipostés".

Est-ce que ce sont tous les documents publipostés ou uniquement certains que tu souhaites fusionner?

Sinon pourquoi ne pas faire le transfert directement par un objet range de ce style, c'est plus rapide que le copier-coller.

Code :

1
2
 
Application.Documents("doccomplet").Range = Application.Documents("current").Range

Pour les styles, c'est étonnant que ce ne soient pas les mêmes s'il s'agit bien de publipostage.