[VBA] Option de recherche dans une zone texte

flywinx

XLDnaute Nouveau
Bonjour,

Je possède un fichier Excel composé uniquement de zones de texte et je souhaiterai être capable de rechercher un mot pour savoir dans quelle zone de texte il se situe.

Pour cela j'ai créé un programme VBA à partir d'anciens messages de forums sur Excel.
Cependant celui-ci ne fonctionne pas puisque le résultat est toujours : "Aucun résultat trouvé".

Le code est le suivant :

VB:
Sub recherchecontenuzone()
Dim laShape As Shape, celluleCentre As Range, centreT As Double, centreL As Double, i As Long
Dim nbColAffichees As Long, nbLigAffichees As Long, decalageCol As Long, decalageLig As Long
Dim mot As String, laFeuille As Worksheet, trouve As Boolean

    'récupérer le mot à rechercher
  mot = InputBox("Mot à rechercher :", "Rechercher")
   
    trouve = False
    'boucler sur chaque feuille du classeur
   For Each laFeuille In ThisWorkbook.Sheets
    'boucler sur toutes les formes de la feuille
   For Each laShape In laFeuille.Shapes
    If laShape.Name Like "Text Box *" Then
    If laShape.TextFrame.Characters.Text Like "*" & mot & "*" Then trouve = True
    If trouve Then Exit For
    End If
    Next laShape
    If trouve Then Exit For
    Next laFeuille
   
    'si aucune forme contenant le numéro d'of n'a été trouvée, quitter la macro
  If laShape Is Nothing Then
                                MsgBox "Non trouvé"
                                Exit Sub
    End If
   
    'activer la feuille et sélectionner la forme
  laFeuille.Activate
    laShape.Select
   
    'centrer la forme à l'écran
  'calculer les "coordonnées" du centre de la forme
  centreT = laShape.Top + laShape.Height / 2
    centreL = laShape.Left + laShape.Width / 2
   
    'calculer la cellule correspondante aux "coordonnées"
  Set celluleCentre = Sheets(1).Range("A1")
       
    While celluleCentre.Offset(0, 1).Left < centreL
        Set celluleCentre = celluleCentre.Offset(0, 1)
    Wend
    While celluleCentre.Offset(1, 0).Top < centreT
        Set celluleCentre = celluleCentre.Offset(1, 0)
    Wend
   
    'vériffier le nombre de lignes et colonnes affichées
  nbColAffichees = ActiveWindow.VisibleRange.Columns.Count
    nbLigAffichees = ActiveWindow.VisibleRange.Rows.Count
   
    'calculer la cellule (colonne et ligne) à afficher en haut à droite
  decalageCol = IIf(celluleCentre.Column - CInt(nbColAffichees / 2) + 1 < 1, 1, celluleCentre.Column - CInt(nbColAffichees / 2) + 1)
    decalageLig = IIf(celluleCentre.Row - CInt(nbLigAffichees / 2) + 1 < 1, 1, celluleCentre.Row - CInt(nbLigAffichees / 2) + 1)
   
    'positionner la fenêtre (bugge depuis VBE, la macro doit être lancée depuis le excel)
  ActiveWindow.ScrollColumn = decalageCol
    ActiveWindow.ScrollRow = decalageLig
End Sub

Je pense qu'il y a un problème à ce niveau :

VB:
      If laShape.Name Like "Text Box *" Then
            If laShape.TextFrame.Characters.Text Like "*" & numOf & "*" Then trouve = True
            If trouve Then Exit For

Auriez-vous une solution à mon problème?

Je joins également à mon message un fichier exemple avec mes zones de texte.

Meric pour toute aide
 

Pièces jointes

  • exemple.xls
    132 KB · Affichages: 94
  • exemple.xls
    132 KB · Affichages: 98
  • exemple.xls
    132 KB · Affichages: 90

Discussions similaires

Réponses
16
Affichages
1 K

Statistiques des forums

Discussions
312 027
Messages
2 084 763
Membres
102 657
dernier inscrit
Ferdy