Recherche de fichier

[zeddeur]

Je suis débutant sur Excel jusqu'à aujourd’hui toute mes questions on trouvées réponse sur votre site j’espère que ça va continuer.
J’ai un problème qui me parait simple mais pour lequel je ne trouve pas de solution.
Dans un même dossier j’ai plusieurs fichier Excel dans les quels des références de pièces sont répertoriées.
J’aimerai trouver une solution pour que rapidement je puisse faire la recherche d’une référence dans tous les fichiers Excel présent dans ce dossier.
Aujourd’hui je suis obligé d’ouvrir chaque fichier un par un et de faire une recherche de la référence avec l’outil « édition » « rechercher »

Avez-vous une solution ?

 

[job75]

Re : Recherche de fichier

Bonjour zeddeur, bienvenue sur XLD,

Voici une macro que vous pouvez copier dans un module (Alt+F11 puis menu Insertion-Module) d'un fichier.

Ce fichier doit être dans le même dossier que les fichiers où l'on fait la recherche.

Vous entrez la référence cherchée dans la cellule A1 et vous exécutez la macro (Alt+F8 ou par un bouton). Si vous voulez une autre cellule, modifiez la ligne en rouge de la macro.

Sub RechercheFichier()
Dim nomfich$, refer$, o As Boolean, Cel As Range
Application.ScreenUpdating = False
On Error Resume Next
nomfich = Dir(ThisWorkbook.Path & "\*.xls") '1er fichier du dossier
[COLOR="Red"]refer = Range("A1")[/COLOR] 'le texte recherché
While nomfich <> "" And refer <> ""
If nomfich <> ThisWorkbook.Name Then
  If IsError(Workbooks(nomfich).Name) Then 'si le fichier n'est pas déjà ouvert, on l'ouvre
    Workbooks.Open ThisWorkbook.Path & "\" & nomfich
    o = True
  Else
    Workbooks(nomfich).Activate
    o = False
  End If
  Windows(nomfich).Visible = True 'au cas où la fenêtre serait masquée, on l'affiche
  Set Cel = Sheets(1).Cells.Find(What:=refer, LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche dans la 1ère feuille du fichier
  If Cel Is Nothing Then 'si la recherche n'aboutit pas
    If o Then ActiveWorkbook.Close SaveChanges:=False 'si le fichier a été ouvert, on le referme
  Else 'si le texte est trouvé
    Sheets(1).Activate
    Application.ScreenUpdating = True
    Cel.Select 'la cellule trouvée est sélectionnée et la macro s'arrête là
    Exit Sub
  End If
End If
nomfich = Dir 'fichier suivant du dossier
Wend
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub

Edition : la recherche se fait toujours dans la 1ère feuille de chaque fichier.

A+

 

[job75]

Re : Recherche de fichier

Re,

Je viens d'éditer des commentaires pour vous aider, prenez la dernière édition.

A+

 

[zeddeur]

Re : Recherche de fichier

Super c'est presque parfait le seul défaut c'est que la macro s'arrête après avoir trouvé la référence recherché. Peut-on poursuivre la recherche de la référence dans le reste des documents et garder ouvert les fichiers ou la référence à été trouvé ?

Merci beaucoup pour votre rapidité de réponse

 

[job75]

Re : Recherche de fichier

Bonjour zeddeur,

Voici la macro modifiée. La cellule trouvée est placée en haut à gauche de l'écran.

Sub RechercheFichier()
Dim nomfich$, refer$, i%, o As Boolean, Cel As Range
Application.ScreenUpdating = False
On Error Resume Next
nomfich = Dir(ThisWorkbook.Path & "\*.xls") '1er fichier du dossier
refer = Range("A1") 'le texte recherché
i = 0
While nomfich <> "" And refer <> ""
If nomfich <> ThisWorkbook.Name Then
  If IsError(Workbooks(nomfich).Name) Then 'si le fichier n'est pas déjà ouvert, on l'ouvre
    Workbooks.Open ThisWorkbook.Path & "\" & nomfich
    o = True
  Else
    Workbooks(nomfich).Activate
    o = False
  End If
  Windows(nomfich).Visible = True 'au cas où la fenêtre serait masquée, on l'affiche
  Set Cel = Sheets(1).Cells.Find(What:=refer, LookIn:=xlFormulas, LookAt:=xlWhole) 'recherche dans la 1ère feuille du fichier
  If Cel Is Nothing Then 'si la recherche n'aboutit pas
    If o Then ActiveWorkbook.Close SaveChanges:=False 'si le fichier a été ouvert, on le referme
  Else 'si le texte est trouvé
    Sheets(1).Activate
    [COLOR="Red"]Application.Goto Cel.Address(ReferenceStyle:=xlR1C1), True[/COLOR] 'cadre la cellule trouvée dans le coin supérieur gauche
    i = i + 1
  End If
End If
nomfich = Dir 'fichier suivant du dossier
Wend
ThisWorkbook.Activate
Application.ScreenUpdating = True
MsgBox IIf(i, "Référence dans " & i & " fichier(s).", "Référence introuvable.")
End Sub

Edition 1 : ajouté un message en fin de macro.

Edition 2 : remplacé par la ligne en rouge.

A+