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 |
[VBA - W] fusion de documents word + garder les styles
Répondre avec citation
Partager