Voici une macro qui va lancer l'enregistrement du document sous un nouveau nom, et va ajouter ce nom dans une liste d'un document existant, que je nomme « sommaire ».
Vous devez donc, avant tout, créer le document Sommaire qui contiendra la liste de tous les documents qui seront enregistrés via cette macro. Il s'agit d'un document vide.
Mettez cette macro soit dans le Normal.dotm, soit dans le modèle spécifique à ce type de documents, soit encore dans un module complémentaire. Reliez cette macro à un bouton que vous mettrez par exemple sur la barre d'outils Accès rapide. Lorsque vous voudrez enregistrez un document et le lister dans le document Sommaire, cliquez sur ce bouton au lieu de faire un Enregistrer sous habituel.
La macro insère le nom avec le lien hypertexte du document, de manière à pouvoir l'ouvrir aisément en cliquant dessus.
Sub enregistre()
Dim sommaire As String, nom As String, nom2 As String
With Dialogs(wdDialogFileSaveAs)
.Show
End With
sommaire = "C:\Users\...\sommaire.docx" 'mettre ici le nom complet du sommaire avec son emplacement
nom = ActiveDocument.FullName
nom2 = ActiveDocument.Name
Documents.Open sommaire
With Documents(sommaire)
.Activate
With Selection
.EndKey Unit:=wdStory
.Range.Paragraphs(1).Range.Hyperlinks.Add Anchor:=Selection.Range, Address:=nom, TextToDisplay:=nom2
.TypeParagraph
End With
.Save
End With
End Sub
Et voici la version luxe qui va lister dans un tableau le nom du fichier avec sa date de création. Avant tout, vous devrez créer un fichier (que j'ai nommé « sommaire ») avec un tableau de deux colonnes, comme ci-dessous.
Sub enregistre2()
Dim sommaire As String, nom As String, nom2 As String, x, madate As Date
madate = Format(Now(), "dd-mmmm-yyyy")
With Dialogs(wdDialogFileSaveAs)
.Show
End With
sommaire = "C:\Users\...\sommaire.docx" 'mettre ici le nom complet du fichier Sommaire
nom = ActiveDocument.FullName
nom2 = ActiveDocument.Name
Documents.Open sommaire
With Documents(sommaire)
.Activate
With ActiveDocument.Tables(1)
.Rows.Add
x = ActiveDocument.Tables(1).Rows.Count
.Rows(x).Select
.Rows(x).Cells(1).Range.Hyperlinks.Add Anchor:=Selection.Range, Address:=nom, TextToDisplay:=nom2
.Rows(x).Cells(2).Range.Text = madate
End With
.Save
End With
End Sub