XL 2016 excel 2016 recherche dans toutes les zones de texte

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

bricoulou

XLDnaute Nouveau
Bonjour
Je souhaite chercher dans toutes les zones de texte et aussi comme la recherche classique d'excel mais dans toutes les feuilles du classeur
comment faudrait il faire (exemple, je cherche le mot "bidon" )
merci à vous et belle journée ;-)
val
 

Pièces jointes

Trier par date Trier par votes
Bonjour Bricoulon,
C'était fait exprès votre "Bldon" au lieu de "Bidon" dans votre zone de texte ? 🙂
Un essai en PJ avec :
VB: 
Sub Chercher()
Dim Chaine$, T, F, Sh, i%, N%
Application.ScreenUpdating = False
Chaine = [C4]
[B9:C1000].ClearContents
L = 1
Redim T(1 To 1000, 1 To 2)
'Pour toutes les feuilles
For Each F In Worksheets
    'Pour tous les shapes
    For Each Sh In Sheets(F.Name).Shapes
        'Si zone de texte alors on récupère les infos
        If Sh.Name Like "ZoneTexte*" Then
            If LCase(Sh.TextFrame.Characters.Text) Like "*" & LCase(Chaine) & "*" Then
                T(L, 1) = F.Name: T(L, 2) = Sh.Name: L = L + 1
            End If
        End If
    Next Sh
    On Error Resume Next
    'Pour toutes les feuilles hors Trouver
    If F.Name <> "Trouver" Then
        Sheets(F.Name).Select: [A1].Select
        'Combien y a t-il de "Chaine" ?
        N = Application.CountIf([A1:ZZ1000], "*" & Chaine & "*")
        'On recherche la 1ere
        Cells.Find(What:=Chaine, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        'Et on récupère les autres
        For i = 1 To N
                Cells.FindNext(After:=ActiveCell).Activate
                T(L, 1) = F.Name: T(L, 2) = ActiveCell.Address: L = L + 1
        Next i
    End If
Next F
Sheets("Trouver").Select
'On restitue la matrice
[B9].Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Merci Sylvanu pour ta réponse super rapide !!!
je viens de l'essayer, il me répond sur la feuil 2, de ce fait bizarre ?:

Feuil1$A$1

Je souhaiterai comme une recherche Excel qu'il se positionne sur les différents cellules ou zone de texte et que je puisse passer au suivant si ce n'est pas celui ci que je cherche, je n'ai peut etre pas été assez claire j'en suis désolée.
Pour le "bidon", lol, ce n'était pas fait exprès merci à ton œil de lynx ;-)
Bien à toi
Val
 
Dernière édition:
Vote positif 0 Vote négatif
Bonjour brocoulou, sylvanu, le fil
sylvanu, je me suis permisd'apporter ces modifications à votre code :
- Test du type des TextBox et non du nom de la TextBox peu fiable
- Scroll si nécessaire pour avoir la TextBox toujours visible dans l'écran
- Utilisation de Rows.Count et Columns.Count et non de [A1:ZZ1000] pour balayer les cellules
VB: 
Sub ChercherBis()
Dim Chaine$, F, Sh, i%, N%, MaRange As Range
Chaine = InputBox("Quelle chaine recherchez vous ?")
If Chaine = "" Then Exit Sub
'Pour toutes les feuilles
For Each F In Worksheets
    F.Select
    'Pour tous les shapes
    For Each Sh In Sheets(F.Name).Shapes
        'Si zone de texte alors on récupère les infos
        If Sh.Type = msoTextBox Then
            If LCase(Sh.TextFrame.Characters.Text) Like "*" & LCase(Chaine) & "*" Then
                ActiveSheet.Shapes(Sh.Name).Select
                ScrollpCellule Sh.TopLeftCell
                DoEvents: Calculate
                Rep = MsgBox("Voulez vous le suivant ?", vbQuestion + vbYesNo + vbQuestion, "Recherche de : " & Chaine)
                If Rep <> 6 Then Exit Sub
            End If
        End If
    Next Sh
    
    On Error Resume Next

    'Combien y a t-il de "Chaine" ?
    Set MaRange = Range(Cells(1, 1), Cells(Rows.Count, Columns.Count))
    N = Application.CountIf(MaRange, "*" & Chaine & "*")
    If N > 0 Then
        'On recherche la 1ere
        Cells.Find(What:=Chaine, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        'Et on récupère les autres
        For i = 1 To N
            Cells.FindNext(After:=ActiveCell).Activate
            ActiveCell.Select
            DoEvents: Calculate
            Rep = MsgBox("Voulez vous le suivant ?", vbQuestion + vbYesNo + vbQuestion, "Recherche de : " & Chaine)
            If Rep <> 6 Then Exit Sub
        Next i
    End If
Next F
End Sub

Sub ScrollpCellule(pCellule As Range)
' Suite à Suivant, on repositionne la textbox Active dans la fenêtre


    If pCellule.Column < ActiveWindow.Panes(1).ScrollColumn Then
        ActiveWindow.ScrollColumn = pCellule.Column
    Else
        Application.ScreenUpdating = False
        ActiveWindow.Panes(1).LargeScroll 0, 0, 1, 0
        If pCellule.Column > ActiveWindow.Panes(1).ScrollColumn Then
            ActiveWindow.Panes(1).LargeScroll 0, 0, -1, 0
            ActiveWindow.ScrollColumn = pCellule.Column
        Else
            ActiveWindow.Panes(1).LargeScroll 0, 0, -1, 0
        End If
        Application.ScreenUpdating = True
    End If
    If pCellule.Row < ActiveWindow.Panes(1).ScrollRow Then
        ActiveWindow.ScrollRow = pCellule.Row
    Else
        Application.ScreenUpdating = False
        ActiveWindow.Panes(1).LargeScroll 1, 0, 0, 0
        If pCellule.Row > ActiveWindow.Panes(1).ScrollRow Then
            ActiveWindow.Panes(1).LargeScroll -1, 0, 0, 0
            ActiveWindow.ScrollRow = pCellule.Row
        Else
            ActiveWindow.Panes(1).LargeScroll -1, 0, 0, 0
        End If
        Application.ScreenUpdating = True
    End If
End Sub
 
Vote positif 0 Vote négatif
Bonjour à tous,

Pourquoi se casser la tête pour un truc aussi simple ? Des MsgBox suffisent s'il y a seulement quelques occurrences :
VB: 
Sub Recherche()
Dim x As Variant, y$, w As Worksheet, c As Range, s As Shape
x = Application.InputBox("Entrez le texte, la casse sera ignorée :", "Recherche")
If x = False Or Trim(x) = "" Then Exit Sub
y = "*" & UCase(Trim(x)) & "*"
For Each w In Worksheets
    For Each c In w.UsedRange
        If UCase(Trim(c)) Like y Then MsgBox "Trouvé en " & w.Name & "!" & c.Address(0, 0), , "Recherche de " & x
    Next c
    On Error Resume Next
    For Each s In w.Shapes
        If Not UCase(Trim(s.TextFrame.Characters.Text)) Like y Then Else MsgBox "Trouvé en " & w.Name & "!" & s.TopLeftCell.Address(0, 0) & ", Shape " & s.Name, , "Recherche de " & x
Next s, w
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Avec des MsgBox à 2 boutons pour choisir la sélection :
VB: 
Sub Recherche()
Dim x As Variant, y$, w As Worksheet, c As Range, s As Shape
x = Application.InputBox("Entrez le texte, la casse sera ignorée :", "Recherche")
If x = False Or Trim(x) = "" Then Exit Sub
y = "*" & UCase(Trim(x)) & "*"
For Each w In Worksheets
    For Each c In w.UsedRange
        If UCase(Trim(c)) Like y Then
            w.Visible = xlSheetVisible 'au cas où
            Application.Goto c
            If MsgBox("Arrêt en " & w.Name & "!" & c.Address(0, 0) & " ?", vbYesNo, "Recherche de " & x) = vbYes Then End
        End If
    Next c
    On Error Resume Next
    For Each s In w.Shapes
        If Not UCase(Trim(s.TextFrame.Characters.Text)) Like y Then
        Else
            w.Visible = xlSheetVisible 'au cas où
            Application.Goto w.Range(s.TopLeftCell, s.BottomRightCell)
            If MsgBox("Arrêt en " & w.Name & "!" & Selection.Address(0, 0) & ", Shape " & s.Name & " ?", vbYesNo, "Recherche de " & x) = vbYes Then End
        End If
Next s, w
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Rebonjour à tous,
Nickel pour la recherche sur les cellule et les zones de textes
Par contre j'ai des zones de textes qui sont groupés, en ce cas, ces macros ne vont pas chercher dans ces zones de textes là exemple ci dessous :
1748879943931.png

Merki à vous, belle soirée à vous tous ;-)
 
Vote positif 0 Vote négatif
La macro ChercherBis du post#6 modifiée pour tenir compte des regroupements
VB: 
Sub ChercherBis()
Dim Chaine$, F, Sh, Shi, i%, N%, MaRange As Range
Chaine = InputBox("Quelle chaine recherchez vous ?")
If Chaine = "" Then Exit Sub
'Pour toutes les feuilles
For Each F In Worksheets
    F.Select
    'Pour tous les shapes
    For Each Sh In Sheets(F.Name).Shapes
        'Si zone de texte alors on récupère les infos
        Select Case Sh.Type
        Case msoTextBox
            If LCase(Sh.TextFrame.Characters.Text) Like "*" & LCase(Chaine) & "*" Then
                ActiveSheet.Shapes(Sh.Name).Select
                ScrollpCellule Sh.TopLeftCell
                DoEvents: Calculate
                Rep = MsgBox(" Actuellement : " & Sh.Name & " .Voulez vous le suivant ?", vbQuestion + vbYesNo + vbQuestion, "Recherche de : " & Chaine)
                If Rep <> 6 Then Exit Sub
            End If
        Case msoGroup
            For Each Shi In Sh.GroupItems
                If Shi.Type = msoTextBox Then
                    If LCase(Shi.TextFrame.Characters.Text) Like "*" & LCase(Chaine) & "*" Then
                        ActiveSheet.Shapes(Shi.Name).Select
                        ScrollpCellule Sh.TopLeftCell
                        DoEvents: Calculate
                        Rep = MsgBox(" Actuellement : " & Shi.Name & " .Voulez vous le suivant ?", vbQuestion + vbYesNo + vbQuestion, "Recherche de : " & Chaine)
                        If Rep <> 6 Then Exit Sub
                    End If
                End If
            Next Shi
        End Select
    Next Sh
    
    On Error Resume Next

    'Combien y a t-il de "Chaine" ?
    Set MaRange = Range(Cells(1, 1), Cells(Rows.Count, Columns.Count))
    N = Application.CountIf(MaRange, "*" & Chaine & "*")
    If N > 0 Then
        'On recherche la 1ere
        Cells.Find(What:=Chaine, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        'Et on récupère les autres
        For i = 1 To N
            Cells.FindNext(After:=ActiveCell).Activate
            ActiveCell.Select
            DoEvents: Calculate
            Rep = MsgBox("Voulez vous le suivant ?", vbQuestion + vbYesNo + vbQuestion, "Recherche de : " & Chaine)
            If Rep <> 6 Then Exit Sub
        Next i
    End If
Next F
End Sub
 
Vote positif 0 Vote négatif
Bonsoir à tous,

bricoulou à dit:
Par contre j'ai des zones de textes qui sont groupés
Cliquez pour agrandir...
Ma macro du post #8 modifiée avec la collection GroupItems :
VB: 
Sub Recherche()
Dim x As Variant, y$, w As Worksheet, c As Range, s As Shape, n, ss As Shape
x = Application.InputBox("Entrez le texte, la casse sera ignorée :", "Recherche")
If x = False Or Trim(x) = "" Then Exit Sub
y = "*" & UCase(Trim(x)) & "*"
For Each w In Worksheets
    For Each c In w.UsedRange
        If UCase(Trim(c)) Like y Then
            w.Visible = xlSheetVisible 'au cas où
            Application.Goto c
            If MsgBox("Arrêt en " & w.Name & "!" & c.Address(0, 0) & " ?", vbYesNo, "Recherche de " & x) = vbYes Then End
        End If
    Next c
    On Error Resume Next
    For Each s In w.Shapes
        n = 0
        n = s.GroupItems.Count
        If n Then
            For Each ss In s.GroupItems
                If Not UCase(Trim(ss.TextFrame.Characters.Text)) Like y Then
                Else
                    w.Visible = xlSheetVisible 'au cas où
                    Application.Goto w.Range(ss.TopLeftCell, ss.BottomRightCell)
                    If MsgBox("Arrêt en " & w.Name & "!" & Selection.Address(0, 0) & ", Shape " & ss.Name & " ?", vbYesNo, "Recherche de " & x) = vbYes Then End
                End If
            Next ss
        Else
            If Not UCase(Trim(s.TextFrame.Characters.Text)) Like y Then
            Else
                w.Visible = xlSheetVisible 'au cas où
                Application.Goto w.Range(s.TopLeftCell, s.BottomRightCell)
                If MsgBox("Arrêt en " & w.Name & "!" & Selection.Address(0, 0) & ", Shape " & s.Name & " ?", vbYesNo, "Recherche de " & x) = vbYes Then End
            End If
        End If
Next s, w
End Sub
A+
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
431
Lu76Fer
Lu76Fer
JTE
  • Résolu(e)
XL 2010 Excel : Zone impression et Zone texte...
Réponses
5
Affichages
510
JTE
JTE
G
  • Question Question
XL 2010 Déplacement de plusieurs zones de texte dans excel vba
2 3
Réponses
36
Affichages
585
sylvanu
sylvanu
C
  • Question Question
XL 2021 Retrouver l'assistant importation de texte quand on fait une extraction à partir d'un .CSV ?
Réponses
6
Affichages
227
cindynico38
C
F
  • Question Question
XL 2016 recherche de mots
2
Réponses
19
Affichages
526
job75
job75
R
  • Résolu(e)
XL 2010 vba excel : recherche concordance chaine texte dans cellule et données stockées dans un tablo (array)
Réponses
4
Affichages
195
Raynaud.JF
R
jeff1494
  • Question Question
XL 2021 Ajout de zones dans un USF par VBA
2
Réponses
16
Affichages
375
jeff1494
jeff1494
F
  • Question Question
XL 2016 Tableau de bord Excel 2016
Réponses
0
Affichages
258
Finix
F
V
  • Résolu(e)
Microsoft 365 Barre de recherche : comment rendre éditable le résultat ?
2 3 4
Réponses
52
Affichages
1 K
dysorthographie
dysorthographie
T
  • Résolu(e)
Microsoft 365 Texte manquant sur l'axe des abscisses dans Excel
Réponses
3
Affichages
323
Efgé
Efgé
R
  • Question Question
Microsoft 365 Protéger les mots de passe
2
Réponses
17
Affichages
514
Phil69970
Phil69970
L
  • Question Question
Microsoft 365 Recherche dans fichier excel dans un répertoire
2
Réponses
18
Affichages
802
job75
job75
A
  • Question Question
Microsoft 365 zones nommées qui ne respectent pas les limites données
2
Réponses
20
Affichages
811
Staple1600
Staple1600
J
  • Question Question
Microsoft 365 VBA transformer une formule au format texte en formule dans excel
Réponses
2
Affichages
172
jujulili
J
M
  • Question Question
XL 2016 comment faire une barre de recherche
Réponses
7
Affichages
530
mumu91800
M
C
  • Résolu(e)
Microsoft 365 Copie texte de word vers Excel
Réponses
10
Affichages
464
chax
C
Caninge
  • Résolu(e)
XL 2010 Recherche parties de mots dans une base de données
2
Réponses
25
Affichages
539
Caninge
Caninge
J
  • Question Question
Microsoft 365 Extraire texte de toutes les zones de texte
Réponses
7
Affichages
661
patricktoulon
patricktoulon
P
  • Question Question
XL 2016 texte d'images vers excel
Réponses
14
Affichages
319
jurassic pork
jurassic pork
R
  • Question Question
Microsoft 365 aide recherche multiple entrées d'une cellule dans colonne
2
Réponses
16
Affichages
958
richard31
R
Retour