bonjour le forum,

je cherche à obtenir la liste des fichiers (répartis dans différents sous-dossiers) qui contiennent une certaine chaîne de caractères dans leur module standard (et autres tant qu'à faire : classe, userform).

exemple concret : parmi la centaine de fichiers dans mon arborescence, je sais que j'ai utilisé le terme "ArrayList" dans le module standard de certains de ces fichiers, mais lesquels ?

j'ai essayé :
- la barre de recherche de l'explorateur (Windows 7), sans succès
- celle d'Excel (2010), quand on est dans la fenêtre "Ouvrir", mais qui ne cherche que dans les feuilles, et non les modules.
- Google, qui ne me proposait que des méthodes pour chercher du texte dans des feuilles

s'il n'y a pas de méthode ad hoc, peut-être que qqn a développé un code VBA permettant de faire ça ?
car je ne dois pas être le premier à tenter ce type de recherche.

Bonjour

une piste sur ce fil !!!!

http://www.excelabo.net/excel/rechercher_remplacer

salutations

ce qui pourrait donner un truc du genre à condition d'ouvrir les classeurs à traiter

Sub Rechercher()

Dim Classeur As Workbook
Dim Module As Object
Dim Rechercher As String
Dim Remplacer As String
Dim Trouver As Integer
Dim I As Integer

'Le module où se trouve cette proc
'doit s'appeler "ModuleDeMiseAJour" afin qu'aucune modif ne soit faite
'dans cette proc
Rechercher = "ArrayList"

For Each Classeur In Workbooks
For Each Module In Classeur.VBProject.VBComponents
With Module.CodeModule
If Module.Name = "ModuleDeMiseAJour" Then GoTo sortie

For I = 1 To .CountOfLines
Trouver = InStr(.Lines(I, 1), Rechercher)
If Trouver > 0 Then
'si une occurrence est trouvée, fait la modif et boucle
'sur la ligne afin de remplacer tous les mots

MsgBox "mot trouvé dans :" & Classeur.Name & " " & Module.Name
End If
Next I
sortie:
'End If
End With

Next Module
Next Classeur
Set Classeur = Nothing
Set Module = Nothing
End Sub

merci Gilbert,

c'est une piste très intéressante pour la partie identification de la chaine de texte dans les modules ; je prends !

il me reste à ajouter le code qui va m'ouvrir tous les fichiers XL d'une arborescence (dossiers et sous dossiers).
un p'tit coup de pouce là dessus ?

Code à mettre dans un module standard

en feuille1 nommer 3 cellules

ExtFich => A3

Titre => D3

DebListe =>D4

mettre en feuille 1 et en cellule a3 (ExtFich) l'extension des fichiers à lister ex : xl* pour les fichiers excel

lancer la macro ci-dessous puis choisir le répertoire

la liste des fichiers sera affichée en feuille 1 colonne D avec un entête indiquant le nombre de fichiers listés

ensuite il faut faire une boucle qui ouvre et qui ferme les fichiers

ça devrait pouvoir fonctionner bon courage le plus dure est trouvé

Public ledos As String
Public msg As String

Function ChoixDossier(chemin)
Dim objShell, objFolder

Set objShell = CreateObject("Shell.Application")

'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, msg, &H1&, chemin)
On Error Resume Next
chemin = objFolder.parentFolder.ParseName(objFolder.Title).Path & ""
ledos = chemin '(.parentFolder)

End Function
Sub ListeFichier()
Dim xxx As String
Dim FichX As String
Dim tabFich() As String
Dim i As Integer
Dim j As Integer
Dim esp As Integer
Dim z As String
Dim x As String
Dim CheminEtFichier As String
Dim SourceFile, DestinationFile

Application.ScreenUpdating = False
'x = "essai"
msg = "Choisissez votre répertoire source :"
ledossier = Path
CheminEtFichier = ChoixDossier(ledossier)
z = ledos
xxx = Worksheets("Fichiers").Range("ExtFich").Value
ReDim tabFich(1)
tabFich(0) = Dir(z & "\*." & xxx)
If tabFich(0) = "" Then
MsgBox "Aucun Document d'extension " & xxx & " dans le dossier en cours."
Exit Sub
End If
i = 1
Do While True
ReDim Preserve tabFich(i + 1)
tabFich(i) = Dir()
If tabFich(i) = "" Then Exit Do
i = i + 1
Loop
ActiveSheet.Range("DebListe").Select
Selection.CurrentRegion.Select
Selection.ClearContents
'supp_chek
For j = 0 To i - 1
ActiveSheet.[Titre].Value = i & " FICHIERS " & UCase(xxx)
ActiveSheet.[DebListe].Offset(j, 0).Value = tabFich(j)
ActiveSheet.[DebListe].Offset(j, -1).Select

Next
ActiveSheet.[Titre].Select

Application.ScreenUpdating = True
MsgBox "La liste des fichiers est copiée"
End Sub

merci beaucoup, tu as bien défriché le terrain.

je vais tester tout ça et adapter à mon besoin (vais probablement mettre un peu de temps pour revenir confirmer que c'est résolu, mais je n'y manquerai pas).

et en prime je mettrai le code que j'aurai adapté pour mon besoin, si ça peut servir à d'autres.

bonjour,

après pas mal de recherchessss complémentairessss, je suis finalement arrivé à un code qui fait ce que je voulais.
voici le résultat pour ceux qui cherchent à faire comme moi.

le scénario :
- je saisis la chaîne de texte à chercher dans les modules de code VBA (avec ou sans respect de la casse), puis choisis le dossier où chercher cette chaîne
- le code parcourt le dossier défini, et tous ses sous-dossiers (sur une profondeur de 5 niveaux dans l'arborescence), puis stocke dans une collection le chemin de tous les fichiers xls* rencontrés
(y a possibilité d'utiliser une méthode récursive, mais je ne maîtrise pas du tout, j'ai donc fait un gros pâté tout moche avec mes _N1, _N2, etc.)
- une boucle ouvre chaque fichier de la liste, et recherche la chaîne de texte dans chaque module de code ; si la chaîne est présente, le nom complet (avec chemin) du fichier est stocké dans une collection
- enfin, la liste des fichiers contenant la chaîne est collé sur une feuille vierge
(je viens de réaliser que je n'ai pas encore géré le cas où aucune correspondance n'est trouvée, ça affiche une feuille vide tout simplement)


(le code est indenté mais j'ai pas réussi à maintenir l'indentation dans mon message)
====================================================================================================


'choix de la chaîne de texte à chercher et du dossier de recherche
TITRE_MSGBOX = "Recherche script VBA"
CHAINE_TXT = InputBox(vbLf & "Chaîne à chercher ?", TITRE_MSGBOX): If CHAINE_TXT = Empty Then Exit Sub
OPTION_CASSE = IIf(MsgBox("Respecter la casse ?", vbQuestion + vbYesNo, TITRE_MSGBOX) = vbYes, vbBinaryCompare, vbTextCompare)
Set OBJ_SYSTEME = CreateObject("Shell.Application")
Set DOSSIER_RECHERCHE = OBJ_SYSTEME.BrowseForFolder(&H0&, "Choisir le dossier de recherche", &H1, "")
If DOSSIER_RECHERCHE Is Nothing Then
MsgBox "Dossier de recherche non sélectionné.", vbCritical, TITRE_MSGBOX: Exit Sub
Else
CHEMIN = DOSSIER_RECHERCHE.ParentFolder.ParseName(DOSSIER_RECHERCHE.Title).Path
End If

'listing des fichiers à scanner (5 niveaux de profondeur dans l'arborescence)
Set LISTE_FICHIERS = CreateObject("System.Collections.ArrayList")
Set OBJ_SYSTEME = CreateObject("Scripting.FileSystemObject")
Set DOSSIER_RECHERCHE = OBJ_SYSTEME.Getfolder(CHEMIN)
Set FICHIERS = DOSSIER_RECHERCHE.Files: GoSub CREATION_LISTE_FICHIERS
Set SOUS_DOSSIERS_N1 = DOSSIER_RECHERCHE.SubFolders
For Each SOUS_DOSS_N1 In SOUS_DOSSIERS_N1
Set FICHIERS = SOUS_DOSS_N1.Files: GoSub CREATION_LISTE_FICHIERS
Set SOUS_DOSSIERS_N2 = SOUS_DOSS_N1.SubFolders
For Each SOUS_DOSS_N2 In SOUS_DOSSIERS_N2
Set FICHIERS = SOUS_DOSS_N2.Files: GoSub CREATION_LISTE_FICHIERS
Set SOUS_DOSSIERS_N3 = SOUS_DOSS_N2.SubFolders
For Each SOUS_DOSS_N3 In SOUS_DOSSIERS_N3
Set FICHIERS = SOUS_DOSS_N3.Files: GoSub CREATION_LISTE_FICHIERS
Set SOUS_DOSSIERS_N4 = SOUS_DOSS_N3.SubFolders
For Each SOUS_DOSS_N4 In SOUS_DOSSIERS_N4
Set FICHIERS = SOUS_DOSS_N4.Files: GoSub CREATION_LISTE_FICHIERS
Set SOUS_DOSSIERS_N5 = SOUS_DOSS_N4.SubFolders
For Each SOUS_DOSS_N5 In SOUS_DOSSIERS_N5
Set FICHIERS = SOUS_DOSS_N5.Files: GoSub CREATION_LISTE_FICHIERS
Next SOUS_DOSS_N5
Next SOUS_DOSS_N4
Next SOUS_DOSS_N3
Next SOUS_DOSS_N2
Next SOUS_DOSS_N1
GoTo SUITE
CREATION_LISTE_FICHIERS:
For Each FICH In FICHIERS
If LCase(Mid(FICH, InStrRev(FICH, ".") + 1, 3)) = "xls" Then LISTE_FICHIERS.Add CStr(FICH)
Next FICH
Return

'ouverture/scan des fichiers et création liste résultat
SUITE:
LISTE_FICHIERS.Sort: NB_FICHIERS = LISTE_FICHIERS.Count
Set LISTE_RESULTAT = CreateObject("System.Collections.ArrayList")
For i = 1 To NB_FICHIERS
Application.StatusBar = "Scan fichier... " & i & "/" & NB_FICHIERS
Workbooks.Open filename:=LISTE_FICHIERS(i - 1), ReadOnly:=True: Set FICHIER_ANALYSE = ActiveWorkbook
For Each MODULE In FICHIER_ANALYSE.VBProject.VBComponents
With MODULE.CodeModule
If .CountOfLines > 0 Then BINGO = InStr(1, .Lines(1, .CountOfLines), CHAINE_TXT, OPTION_CASSE) Else BINGO = 0
End With
If BINGO > 0 Then
LISTE_RESULTAT.Add FICHIER_ANALYSE.FullName: Exit For
End If
Next MODULE: Windows(FICHIER_ANALYSE.Name).Close savechanges:=False
Next i
Workbooks.Add: ActiveSheet.Name = "Résultat"
For i = 1 To LISTE_RESULTAT.Count
Cells(i, 1).Formula = LISTE_RESULTAT(i - 1)
Next i
Application.StatusBar = False