Recherche dans cellules ET zones de texte dans TOUTES les feuilles

[sabsou]

Bonjour!

Etant débutant avec excel et travaillant dans une grande boîte l'utilisant beaucoup je me permets de vous demander de l'aide.
Voici mon problème:
Je souhaiterais trouver un programme VBA pour pouvoir rechercher un mot ou référence dans toutes les feuilles d'un doc excel.
Ces feuilles comprennent aussi des zones de texte à ne pas laisser de côté.

J'ai déjà un programme pour chercher dans les zones de texte, mais il s’arrête à la première valeur trouvée.
J'en ai un autre qui cherche dans les cellules, surligne en vert et met en gras les valeurs trouvées, et équipé d'un bouton "continuer de chercher ( oui / non )". Celui-ci bien sympa.

Serait-il possible de combiner les deux dans un seul programme avec cette même interface utilisateur?
Tout en pouvant entrer un bout de valeur pour trouver le reste.

Ceci est uniquement pour de la recherche, non pour la modification.


Merci!

 

[Dranreb]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Bonjour.
Cette procédure vous irait-elle ?

Sub RechercherPartout()
Dim Txt As String, F As Worksheet, Adr As String, Cel As Range, AncPosC As Long, Des As Shape, TxtDes As String
Txt = UCase(InputBox("Texte à rechercher", "Rechercher partout"))
If Txt = "" Then Exit Sub
For Each F In ActiveWorkbook.Worksheets
   Set Cel = F.Cells.Find(What:=Txt, LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
   If Not Cel Is Nothing Then
      Adr = Cel.Address
      Do
         F.Activate: Cel.Select
         If MsgBox("Cellule " & Cel.Address(False, False) & " :" & vbLf & Trim$(Cel.Value) _
            & vbLf & "___________" & vbLf & "Continuer ?", vbYesNo, "Recherche """ & Txt & """.") = vbNo Then Exit Sub
         Set Cel = F.Cells.FindNext(After:=Cel)
         If Cel Is Nothing Then Exit Do
         Loop Until Cel.Address = Adr
      End If
   For Each Des In F.Shapes
      On Error Resume Next: TxtDes = "": TxtDes = Des.TextFrame.Characters.Text: On Error GoTo 0
      If TxtDes Like "*" & Txt & "*" Then
         Set Cel = Application.Range(Des.TopLeftCell, Des.BottomRightCell)
         F.Activate: Cel.Select
         If MsgBox("Texte dans " & Cel.Address(False, False) & " :" & vbLf & Trim$(TxtDes) _
            & vbLf & "___________" & vbLf & "Continuer ?", vbYesNo, "Recherche """ & Txt & """.") = vbNo Then Exit Sub
         End If
      Next Des
   Next F
End Sub

À +

 

[sabsou]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Bonjour! Merci d'aider, mais cela m'indique une erreur de compilation à la 8e Ligne... "SearchFormat:=False"

 

[Dranreb]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Bonjour
Juste à cette ligne ? pas la précédente ? Manquerait-il le "_" de continuation ?
Essayez en mettant l'instruction sur 2 lignes seulement:

Set Cel = F.Cells.Find(What:=Txt, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

voyez aussi si tous les paramètre de Find sont supporté par votre version d'Excel.
À +

 

[sabsou]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Merci de me suivre!
Donc l'erreur est toujours présente, me disant que "Argument nommé introuvable" en surlignant - searchFormat:= -

Après je ne sais pas du tout comment vérifier les quelconques paramètres de compatibilité...

 

[Dranreb]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Bonjour.
Mettez le curseur texte sur "Find", touche F1.
Supprimez ce paramètre si ça n'existe pas chez vous.
Cordialement

 

[sabsou]

Re : Recherche dans cellules ET zones de texte dans TOUTES les feuilles

Merci, cela fonctionne du tonnerre! Je vais économiser un temps considérable!
Je replace la formule complète pour les intéressés!

Sub RechercherPartout()
Dim Txt As String, F As Worksheet, Adr As String, Cel As Range, AncPosC As Long, Des As Shape, TxtDes As String
Txt = UCase(InputBox("Texte à rechercher", "Rechercher partout"))
If Txt = "" Then Exit Sub
For Each F In ActiveWorkbook.Worksheets
Set Cel = F.Cells.Find(What:=Txt, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
      SearchDirection:=xlNext, MatchCase:=False)
   If Not Cel Is Nothing Then
      Adr = Cel.Address
      Do
         F.Activate: Cel.Select
         If MsgBox("Cellule " & Cel.Address(False, False) & " :" & vbLf & Trim$(Cel.Value) _
            & vbLf & "___________" & vbLf & "Continuer ?", vbYesNo, "Recherche """ & Txt & """.") = vbNo Then Exit Sub
         Set Cel = F.Cells.FindNext(After:=Cel)
         If Cel Is Nothing Then Exit Do
         Loop Until Cel.Address = Adr
      End If
   For Each Des In F.Shapes
      On Error Resume Next: TxtDes = "": TxtDes = Des.TextFrame.Characters.Text: On Error GoTo 0
      If TxtDes Like "*" & Txt & "*" Then
         Set Cel = Application.Range(Des.TopLeftCell, Des.BottomRightCell)
         F.Activate: Cel.Select
         If MsgBox("Texte dans " & Cel.Address(False, False) & " :" & vbLf & Trim$(TxtDes) _
            & vbLf & "___________" & vbLf & "Continuer ?", vbYesNo, "Recherche """ & Txt & """.") = vbNo Then Exit Sub
         End If
      Next Des
   Next F
End Sub