user_mobilelogo

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

Aujourd'hui2002
Hier2514
Cette semaine12416
Ce mois70196
Total depuis 200411584465

15
visiteurs actuellement en ligne

29 mai 2020