Marco recherche dans windows
llochou
Messages postés
1
Date d'inscription
jeudi 23 décembre 2010
Statut
Membre
Dernière intervention
23 décembre 2010
-
23 déc. 2010 à 19:08
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 31 déc. 2010 à 08:42
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 31 déc. 2010 à 08:42
1 réponse
cs_Le Pivert
Messages postés
7903
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
11 mars 2024
137
31 déc. 2010 à 08:42
31 déc. 2010 à 08:42
Bonjour,
Code pour rechercher un mot dans un dossier de fichiers xls. Suivant le nbre de fichiers l'opération peut se révéler très longue, car ce code ouvre tous les fichiers et parcourt toutes les feuilles.En activant les MsgBox on peut suivre l'opération pas à pas et quitter la boucle quand on le désire.
Pour lancer la macro:
Bonne fin d'année et bons voeux pour la nouvelle année
@+ Le Pivert
Code pour rechercher un mot dans un dossier de fichiers xls. Suivant le nbre de fichiers l'opération peut se révéler très longue, car ce code ouvre tous les fichiers et parcourt toutes les feuilles.En activant les MsgBox on peut suivre l'opération pas à pas et quitter la boucle quand on le désire.
Option Explicit
Dim Plage As Range
Dim Adresse As String
Dim C As Object
Dim Ws As Worksheet
Dim Compteur As Integer
Dim Cel As Range
Dim mot As String
Dim cheminfichier As String
Dim I As Long, R As Integer
Dim Directory
Sub ListFiles()
Range("a:a").ClearContents ' on efface la liste
mot = InputBox("Entrez le mot à rechercher: ", "Mot à rechercher")
If mot = "" Then Exit Sub
'Quel répertoire?
Directory = ChoisirDossier
If Directory = "" Then
MsgBox "Opération annulée par l'utilisateur", vbExclamation, "ERREUR"
Exit Sub
Else
If MsgBox("Attention, si le nombre de fichiers est important, l'opération peut se révéler très longue. Voulez-vous continuer?", vbYesNo, "RECHERCHE") = vbYes Then
'Récupérez les fichiers
On Error Resume Next
Dim MonFichier As Workbook
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = ".xls" 'mettre l'extension
.SearchSubFolders = False 'sans sous-dossier
.Execute
'Donnez les informations du fichier
For I = 1 To .FoundFiles.Count
cheminfichier = .FoundFiles(I)
Set MonFichier = Workbooks.Open(cheminfichier) 'ouvre le classeur
' MsgBox "Classeur ouvert: " & cheminfichier, vbInformation, "Nom du classeur"
RechercheMot ' recherche le mot dans le classeur
' Select Case MsgBox("Voulez-vous fermer ce classeur?" & Chr(10) & "Pour quitter, cliquez sur Annuler", vbYesNoCancel, "RECHERCHE") 'si il n'y a rien dans le classeur
' Case vbYes
'on ferme le classeur
MonFichier.Close SaveChanges:=False 'on ferme sans enregistrer
' Case vbNo
'On continue la boucle
Afficher_classeur
'Case vbCancel
' Exit Sub 'On quitte la boucle
' End Select
R = R + 1
Next I
End With
Else
Exit Sub
End If
End If
End Sub
Function ChoisirDossier()
Dim objShell, objFolder, chemin As String, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisissez un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.Items.Item.Path
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function
Sub RechercheMot()
For Each Ws In Worksheets
Ws.Activate
Range("A1").Select
Set Plage = Cells
With Plage
Set C = .Find(mot)
If C Is Nothing Then
'MsgBox "Le mot recherché ne se trouve pas dans la " & Ws.Name, vbInformation, "Résultat"
Else
If Not C Is Nothing Then
Adresse = C.Address
Do
C.Select
'MsgBox "Le mot recherché se trouve dans la : " & Ws.Name & " à cet emplacement " & C.Address, vbInformation, "Résultat"
Afficher_feuille
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Adresse
End If
End If
End With
Next
End Sub
Sub Afficher_classeur()
Workbooks(1).Activate
'On affecte la cellule "A1" à la variable Cel
Set Cel = Range("A1")
Range("A1") = "Noms des feuilles et du classeur" 'ligne d'en-tête
Range("A1").Font.Bold = True
Compteur = 1
'Le bloc d'instruction suivant va se répéter tant que la cellule n'est pas vide
Do While Cel.Offset(Compteur) <> ""
'Ne pas oublier d'incrémenter le compteur sinon la boucle ne pourra pas s'arrêter.
Compteur = Compteur + 1
Loop
Cel.Offset(Compteur) = "dans le classeur: " & cheminfichier
' ActiveSheet.UsedRange.EntireColumn.AutoFit'redimensionner la colonne
' ActiveWindow.Zoom = 100
End Sub
Sub Afficher_feuille()
Workbooks(1).Activate
'On affecte la cellule "A1" à la variable Cel
Set Cel = Range("A1")
Compteur = 1
'Le bloc d'instruction suivant va se répéter tant que la cellule n'est pas vide
Do While Cel.Offset(Compteur) <> ""
'Ne pas oublier d'incrémenter le compteur sinon la boucle ne pourra pas s'arrêter.
Compteur = Compteur + 1
Loop
Cel.Offset(Compteur) = "Le mot recherché se trouve dans la : " & Ws.Name & " à cet emplacement " & C.Address
End Sub
Pour lancer la macro:
Private Sub CommandButton1_Click() ListFiles End Sub
Bonne fin d'année et bons voeux pour la nouvelle année
@+ Le Pivert
