Bonsoir tyuiop
(azert... ? )
Tu trouveras ci-joint un fichier pouvant peut-être répondre à ton problème...
'ATTENTION : nécessite une référence à la librairie
'Microsoft Visual Basic For Applications Extensibility 5.3
'
Private Function ContientMacros(Classeur As Workbook) As Boolean
Dim Obj As Object
For Each Obj In Classeur.VBProject.VBComponents
With Obj.CodeModule
ContientMacros = .CountOfDeclarationLines + 1 < .CountOfLines
End With
If ContientMacros Then Exit For
Next Obj
End Function
Sub TestClasseurs()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String, CeFichier As String
Dim L As Long
Application.ScreenUpdating = False
CeFichier = ThisWorkbook.Name
'Chemin du dossier à analyser (à adapter au besoin)
Chemin = ThisWorkbook.Path & '\'
'Analyse du dossier
L = 1
Set Dossier = CreateObject('Scripting.FileSystemObject').GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Fichier.Name <> CeFichier Then
'Liste les fichiers Excel en précisant s'ils contiennent des macros
If Right(Fichier.Name, 3) = 'xls' Then
L = L + 1
Workbooks.Open Chemin & Fichier.Name
With ThisWorkbook.Sheets('Test')
.Cells(L, 2) = Fichier.Name
.Cells(L, 1) = IIf(ContientMacros(ActiveWorkbook), 'OUI', '')
End With
ActiveWorkbook.Close False
End If
End If
Next
Set Dossier = Nothing
Application.ScreenUpdating = True
MsgBox L & ' classeurs trouvés !'
End Sub
Cordialement. [file name=TestMacrosClasseurs.zip size=15397]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/TestMacrosClasseurs.zip[/file]