Je cherche un code qui trouve dans un rep. des classeurs contenant des macros.
43 réponses
Emile63
Bonjour a tous,
Je recherche un code qui me permettrait de lister dans un classeur,
depuis un r=E9pertoire, donn=E9 tous les fichiers (Excel + Word, serrait
encore mieux) qu'il contient et la colonne d'=E0 c=F4t=E9, s'ils comprennen=
t
des macros VBA.
Je vous remercie d'avance pour vos propositions,
Cordialement,
Emile
voici un exemple que j'ai adapté avec la macro "Liste" de Alain Cros,
Sub test1() Dim i&, t$, ww As Object Set fs = Application.FileSearch Set ww = ThisWorkbook ' à adapter With fs .LookIn = "C:zzListe" ' à adapter .Filename = "*.xls" .Execute If .FoundFiles.Count = 0 Then MsgBox "Aucun fichier n'a été trouvé." Exit Sub End If
For i = 1 To .FoundFiles.Count ' MsgBox .FoundFiles(i) Workbooks.Open Filename:=.FoundFiles(i) t = ActiveWorkbook.Name ww.Activate Liste (t) Workbooks(t).Close SaveChanges:úlse Next i End With End Sub
Sub Liste(WK$) Dim DepLine&, FinLine&, i&, d&, AncLine&, LaProc$ Dim MonTab() As String, ModCod As Object If Workbooks(WK).VBProject.Protection = 1& Then _ MsgBox "Accès impossible car le projet est protégé": Exit Sub ReDim MonTab(1& To 2&, 1& To 2&) MonTab(1&, 1&) = Workbooks(WK).FullName MonTab(1&, 2&) = "Module" MonTab(2&, 2&) = "Procédure" For Each ModCod In Workbooks(WK).VBProject.VBComponents i = UBound(MonTab, 2&) + 1& ReDim Preserve MonTab(1& To 2&, 1& To i) With ModCod.CodeModule MonTab(1&, i) = .Parent.Name DepLine = .CountOfDeclarationLines FinLine = .CountOfLines
Do If FinLine > DepLine Then On Error Resume Next For i = 0& To 3& LaProc = .ProcOfLine(DepLine + 1&, i) AncLine = .ProcBodyLine(LaProc, i) DepLine = DepLine + .ProcCountLines(LaProc, i) If Not Err.Number Then Exit For Next i On Error GoTo 0 i = UBound(MonTab, 2&) If MonTab(2&, i) <> "" Then i = i + 1& ReDim Preserve MonTab(1& To 2&, 1& To i) End If MonTab(2&, i) = LaProc Else Exit Do End If Loop End With Next Set ModCod = Nothing Application.ScreenUpdating = False With ActiveWorkbook.ActiveSheet d = .Range("A65536").End(xlUp).Row + 2 .Range("A" & d).Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab) End With Application.ScreenUpdating = True End Sub 'Alain CROS
isabelle
Le 2010-09-15 13:02, Emile63 a écrit :
Bonjour a tous,
Je recherche un code qui me permettrait de lister dans un classeur, depuis un répertoire, donné tous les fichiers (Excel + Word, serrait encore mieux) qu'il contient et la colonne d'à côté, s'ils comprennent des macros VBA. Je vous remercie d'avance pour vos propositions, Cordialement, Emile
bonjour Emile,
voici un exemple que j'ai adapté avec la macro "Liste" de Alain Cros,
Sub test1()
Dim i&, t$, ww As Object
Set fs = Application.FileSearch
Set ww = ThisWorkbook ' à adapter
With fs
.LookIn = "C:zzListe" ' à adapter
.Filename = "*.xls"
.Execute
If .FoundFiles.Count = 0 Then
MsgBox "Aucun fichier n'a été trouvé."
Exit Sub
End If
For i = 1 To .FoundFiles.Count
' MsgBox .FoundFiles(i)
Workbooks.Open Filename:=.FoundFiles(i)
t = ActiveWorkbook.Name
ww.Activate
Liste (t)
Workbooks(t).Close SaveChanges:úlse
Next i
End With
End Sub
Sub Liste(WK$)
Dim DepLine&, FinLine&, i&, d&, AncLine&, LaProc$
Dim MonTab() As String, ModCod As Object
If Workbooks(WK).VBProject.Protection = 1& Then _
MsgBox "Accès impossible car le projet est protégé": Exit Sub
ReDim MonTab(1& To 2&, 1& To 2&)
MonTab(1&, 1&) = Workbooks(WK).FullName
MonTab(1&, 2&) = "Module"
MonTab(2&, 2&) = "Procédure"
For Each ModCod In Workbooks(WK).VBProject.VBComponents
i = UBound(MonTab, 2&) + 1&
ReDim Preserve MonTab(1& To 2&, 1& To i)
With ModCod.CodeModule
MonTab(1&, i) = .Parent.Name
DepLine = .CountOfDeclarationLines
FinLine = .CountOfLines
Do
If FinLine > DepLine Then
On Error Resume Next
For i = 0& To 3&
LaProc = .ProcOfLine(DepLine + 1&, i)
AncLine = .ProcBodyLine(LaProc, i)
DepLine = DepLine + .ProcCountLines(LaProc, i)
If Not Err.Number Then Exit For
Next i
On Error GoTo 0
i = UBound(MonTab, 2&)
If MonTab(2&, i) <> "" Then
i = i + 1&
ReDim Preserve MonTab(1& To 2&, 1& To i)
End If
MonTab(2&, i) = LaProc
Else
Exit Do
End If
Loop
End With
Next
Set ModCod = Nothing
Application.ScreenUpdating = False
With ActiveWorkbook.ActiveSheet
d = .Range("A65536").End(xlUp).Row + 2
.Range("A" & d).Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab)
End With
Application.ScreenUpdating = True
End Sub 'Alain CROS
isabelle
Le 2010-09-15 13:02, Emile63 a écrit :
Bonjour a tous,
Je recherche un code qui me permettrait de lister dans un classeur,
depuis un répertoire, donné tous les fichiers (Excel + Word, serrait
encore mieux) qu'il contient et la colonne d'à côté, s'ils comprennent
des macros VBA.
Je vous remercie d'avance pour vos propositions,
Cordialement,
Emile
voici un exemple que j'ai adapté avec la macro "Liste" de Alain Cros,
Sub test1() Dim i&, t$, ww As Object Set fs = Application.FileSearch Set ww = ThisWorkbook ' à adapter With fs .LookIn = "C:zzListe" ' à adapter .Filename = "*.xls" .Execute If .FoundFiles.Count = 0 Then MsgBox "Aucun fichier n'a été trouvé." Exit Sub End If
For i = 1 To .FoundFiles.Count ' MsgBox .FoundFiles(i) Workbooks.Open Filename:=.FoundFiles(i) t = ActiveWorkbook.Name ww.Activate Liste (t) Workbooks(t).Close SaveChanges:úlse Next i End With End Sub
Sub Liste(WK$) Dim DepLine&, FinLine&, i&, d&, AncLine&, LaProc$ Dim MonTab() As String, ModCod As Object If Workbooks(WK).VBProject.Protection = 1& Then _ MsgBox "Accès impossible car le projet est protégé": Exit Sub ReDim MonTab(1& To 2&, 1& To 2&) MonTab(1&, 1&) = Workbooks(WK).FullName MonTab(1&, 2&) = "Module" MonTab(2&, 2&) = "Procédure" For Each ModCod In Workbooks(WK).VBProject.VBComponents i = UBound(MonTab, 2&) + 1& ReDim Preserve MonTab(1& To 2&, 1& To i) With ModCod.CodeModule MonTab(1&, i) = .Parent.Name DepLine = .CountOfDeclarationLines FinLine = .CountOfLines
Do If FinLine > DepLine Then On Error Resume Next For i = 0& To 3& LaProc = .ProcOfLine(DepLine + 1&, i) AncLine = .ProcBodyLine(LaProc, i) DepLine = DepLine + .ProcCountLines(LaProc, i) If Not Err.Number Then Exit For Next i On Error GoTo 0 i = UBound(MonTab, 2&) If MonTab(2&, i) <> "" Then i = i + 1& ReDim Preserve MonTab(1& To 2&, 1& To i) End If MonTab(2&, i) = LaProc Else Exit Do End If Loop End With Next Set ModCod = Nothing Application.ScreenUpdating = False With ActiveWorkbook.ActiveSheet d = .Range("A65536").End(xlUp).Row + 2 .Range("A" & d).Resize(UBound(MonTab, 2&), 2&) = Application.Transpose(MonTab) End With Application.ScreenUpdating = True End Sub 'Alain CROS
isabelle
Le 2010-09-15 13:02, Emile63 a écrit :
Bonjour a tous,
Je recherche un code qui me permettrait de lister dans un classeur, depuis un répertoire, donné tous les fichiers (Excel + Word, serrait encore mieux) qu'il contient et la colonne d'à côté, s'ils comprennent des macros VBA. Je vous remercie d'avance pour vos propositions, Cordialement, Emile
Emile63
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne: Set fs = Application.FileSearch Je suis sur Excel 2003 SP3 - WinXP Pro -Est-ce qu'il me manquerait une bibliothèque?
Merci pour ton aide. Cordialement, Emile
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne:
Set fs = Application.FileSearch
Je suis sur Excel 2003 SP3 - WinXP Pro
-Est-ce qu'il me manquerait une bibliothèque?
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne: Set fs = Application.FileSearch Je suis sur Excel 2003 SP3 - WinXP Pro -Est-ce qu'il me manquerait une bibliothèque?
Merci pour ton aide. Cordialement, Emile
isabelle
oui, Microsoft Office 11.0 Object Library
isabelle
Le 2010-09-17 02:15, Emile63 a écrit :
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne: Set fs = Application.FileSearch Je suis sur Excel 2003 SP3 - WinXP Pro -Est-ce qu'il me manquerait une bibliothèque?
Merci pour ton aide. Cordialement, Emile
oui, Microsoft Office 11.0 Object Library
isabelle
Le 2010-09-17 02:15, Emile63 a écrit :
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne:
Set fs = Application.FileSearch
Je suis sur Excel 2003 SP3 - WinXP Pro
-Est-ce qu'il me manquerait une bibliothèque?
Bonjour Isabelle,J'ai une "Erreur 1004" avec cette ligne: Set fs = Application.FileSearch Je suis sur Excel 2003 SP3 - WinXP Pro -Est-ce qu'il me manquerait une bibliothèque?
Merci pour ton aide. Cordialement, Emile
Emile63
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications
Microsoft Excel 11.0 Object Library
Microsoft Office 11.0 Object Library
OLE Automation
Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
isabelle
peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications
Microsoft Excel 11.0 Object Library
Microsoft Office 11.0 Object Library
OLE Automation
Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
michdenis
Bonjour Isabelle,
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
"isabelle" a écrit dans le message de groupe de discussion : i6vave$nud$ peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
Bonjour Isabelle,
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
"isabelle" <i@v.org> a écrit dans le message de groupe de discussion : i6vave$nud$1@speranza.aioe.org...
peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications
Microsoft Excel 11.0 Object Library
Microsoft Office 11.0 Object Library
OLE Automation
Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
"isabelle" a écrit dans le message de groupe de discussion : i6vave$nud$ peut faire un autre essai en ajoutant cette declaration,
Dim FS As Office.FileSearch
isabelle
Le 2010-09-17 04:45, Emile63 a écrit :
Bonjour Isabelle,
Voici, et dans l'ordre celle qui sont séléctionnées :
Visual Bassic For Applications Microsoft Excel 11.0 Object Library Microsoft Office 11.0 Object Library OLE Automation Microsoft Word 11.0 Object Library
Je vois pas a quoi se réfère cette erreur "1004"...
Merci pour ta sollicitude, Cordialement, Emile
Fredo P.
Bonjour MichDenis Est ce que je peux suggérer à sire Denis de jeter un oeil sur le post d'Emile de 8:15
Cordialement Fredo P.
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
Do While sFil <> "" Set fich = Workbooks.Open(sPath & "" & sFil) wks.Activate Liste (fich.Name) fich.Close SaveChanges:úlse sFil = Dir Loop Application.ScreenUpdating = True End Sub
isabelle
Le 2010-09-17 06:50, michdenis a écrit :
Bonjour Isabelle,
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
bonjour Denis et Emile,
alors remplacer la macro test1 par test2,
Sub test2()
Dim wks As Object, fich, sPath, sFil
Application.ScreenUpdating = False
Set wks = ThisWorkbook
Do While sFil <> ""
Set fich = Workbooks.Open(sPath & "" & sFil)
wks.Activate
Liste (fich.Name)
fich.Close SaveChanges:úlse
sFil = Dir
Loop
Application.ScreenUpdating = True
End Sub
isabelle
Le 2010-09-17 06:50, michdenis a écrit :
Bonjour Isabelle,
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
Do While sFil <> "" Set fich = Workbooks.Open(sPath & "" & sFil) wks.Activate Liste (fich.Name) fich.Close SaveChanges:úlse sFil = Dir Loop Application.ScreenUpdating = True End Sub
isabelle
Le 2010-09-17 06:50, michdenis a écrit :
Bonjour Isabelle,
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
michdenis
Je n'ai pas lu tout le fil...
Si le demandeur à Excel 2003, il n'y a pas de raison qu'une erreur soit générée!
Cependant, ce dernier doit s'assurer que les 2 cases à cocher dans le bas de la fenêtre suivante sont cochées : Barre des menus / outils / Macro / sécurité / Onglet : Éditeurs approuvés
"Fredo P." a écrit dans le message de groupe de discussion : i6vj1s$83v$ Bonjour MichDenis Est ce que je peux suggérer à sire Denis de jeter un oeil sur le post d'Emile de 8:15
Cordialement Fredo P.
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
Si le demandeur à Excel 2003, il n'y a pas de raison qu'une erreur soit générée!
Cependant, ce dernier doit s'assurer que les 2 cases à cocher dans le bas de la fenêtre suivante sont cochées :
Barre des menus / outils / Macro / sécurité / Onglet : Éditeurs approuvés
"Fredo P." <ponsinet.frederic363@otezcelaorange.fr> a écrit dans le message de groupe de discussion :
i6vj1s$83v$1@speranza.aioe.org...
Bonjour MichDenis
Est ce que je peux suggérer à sire Denis de jeter un oeil sur le post
d'Emile de 8:15
Cordialement
Fredo P.
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
Si le demandeur à Excel 2003, il n'y a pas de raison qu'une erreur soit générée!
Cependant, ce dernier doit s'assurer que les 2 cases à cocher dans le bas de la fenêtre suivante sont cochées : Barre des menus / outils / Macro / sécurité / Onglet : Éditeurs approuvés
"Fredo P." a écrit dans le message de groupe de discussion : i6vj1s$83v$ Bonjour MichDenis Est ce que je peux suggérer à sire Denis de jeter un oeil sur le post d'Emile de 8:15
Cordialement Fredo P.
Depuis Excel 2007, "FileSearch" n'est plus disponible en VBA
Michel, Oui, les deux cases sont cochées. Isabelle, malheureusement la déclaration: Dim FS As Office.FileSearch n'arrange rien, et j'ai la même erreur. Et le remplacement de Test1 par Test2 ne fonctionne pas non plus. En fait, je souhaite me renseigner des fichier + macros existant dans le serveur de la société. et déclare le sPath comme suit:
Malheureusement, le fichier qu'il rapporte de Dir dans sFil, provient du repertoire (actuel) de la machine dans ce cas le Temporaire, et bien sur il ne trouve pas ce fichier dans le répertoire indiqué(sPath). Une idée.. :-)) Cordialement,
Emile
Bonjour Isabelle et MichDenis,
Michel, Oui, les deux cases sont cochées.
Isabelle, malheureusement la déclaration: Dim FS As Office.FileSearch
n'arrange rien, et j'ai la même erreur.
Et le remplacement de Test1 par Test2 ne fonctionne pas non plus.
En fait, je souhaite me renseigner des fichier + macros existant dans
le serveur de la société.
et déclare le sPath comme suit:
Malheureusement, le fichier qu'il rapporte de Dir dans sFil, provient
du repertoire (actuel) de la machine dans ce cas le Temporaire, et
bien sur il ne trouve pas ce fichier dans le répertoire
indiqué(sPath).
Une idée.. :-))
Cordialement,
Michel, Oui, les deux cases sont cochées. Isabelle, malheureusement la déclaration: Dim FS As Office.FileSearch n'arrange rien, et j'ai la même erreur. Et le remplacement de Test1 par Test2 ne fonctionne pas non plus. En fait, je souhaite me renseigner des fichier + macros existant dans le serveur de la société. et déclare le sPath comme suit:
Malheureusement, le fichier qu'il rapporte de Dir dans sFil, provient du repertoire (actuel) de la machine dans ce cas le Temporaire, et bien sur il ne trouve pas ce fichier dans le répertoire indiqué(sPath). Une idée.. :-)) Cordialement,