Recherche

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
 

 

 

 

Statistiques

France 72,8% France
Canada 7,8% Canada
États-Unis d'Amérique 3,9% États-Unis d'Amérique

Total:

102

Pays
018295761
Aujourd'hui: 36
Hier: 228
Cette semaine: 1.424
Semaine dernière: 1.699
Ce mois: 264