Option Explicit

Public Sub BatchMacro_v2()
' Exécute une macro par lot sur une série de fichiers
' Version légère à partir de WD2002 seulement : utilise le FilePicker
' Anacoluthe pour le MPFW et la FAQ à m@rina

Dim NomMacro As String
Dim vFichier As Variant
Dim RetourDL As Long
Dim NbFichOK As Integer

' 1- Sélection des fichiers
' Le FilePicker permet de sélectionner le répertoire puis dedans
' des fichiers avec Maj ou Ctrl ou tous les fichiers avec Ctrl+A
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
    fd.title = "BATCH: Sélectionner les fichiers à traiter"
    fd.Filters.Add _
    "Documents", "*.doc; *.dot; *.html; *.htm; *.rtf", 1
If fd.Show <> -1 Then Exit Sub
If MsgBox(fd.SelectedItems.count & " documents à traiter ", vbYesNo, _
   "continuer ?") = vbNo Then Exit Sub
   
' 2- Sélection de la macro
MsgBox "Choisissez maintenant la macro" & vbCr & _
"et appuyez sur le bouton Exécuter"
With Application.Dialogs(wdDialogToolsMacro)
     RetourDL = .Display
     NomMacro = .name
End With
If RetourDL <> 1 Then Exit Sub
If InStr(NomMacro, "Batch") <> 0 _
   Then MsgBox "Pas Batchmacro de Batchmacro !": Exit Sub

' 3- Exécution de la macro dans tous les fichiers choisis
' la macro doit agir uniquement sur le document actif sans le fermer
For Each vFichier In fd.SelectedItems
    On Error GoTo Suivant
    Application.Documents.Open FileName:=vFichier, _
    addtorecentfiles:=False, ConfirmConversions:=True, _
    visible:=True
    On Error GoTo Fermer
    Application.Run (NomMacro)
    NbFichOK = NbFichOK + 1
Fermer:
    On Error GoTo Suivant
    ActiveDocument.Close SaveChanges:=wdSaveChanges
Suivant:
    On Error GoTo 0
Next vFichier

' 4 fin de la BatchMacro
MsgBox ("La macro " & NomMacro & " a été exécutée sur " _
& NbFichOK & " Fichiers")
Set fd = Nothing
End Sub