![]() |
|
Forum
|
|
|
#2 (permalink) |
|
XLDnaute Barbatruc
Date d'inscription: février 2005
Messages: 2 284
|
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').GetFold er(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] |
|
|
|
| ANNONCES | |
![]() |
| Liens sociaux |
| Outils de la discussion | |
|
|