Rechercher dans une zone de texte

Bonjour,

Je cherche a faire une fonction rechercher dans des zones de textes.

J'ai un document qui contient uniquement des zones de texte pour réaliser un planning, après quelque recherche on ma donner se code. Il fonctionne parfaitement sur un fichier test mais pas sur le fichier réel:

Private Sub test()
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 numOf As String, laFeuille As Worksheet, trouve As Boolean

    'récupérer le numéro d'OF à rechercher
  numOf = InputBox("Numéro d'OF à 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.TextFrame.Characters.Text Like "*" & numOf & "*" Then trouve = True
            If trouve Then Exit For
        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("Feuil1").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

La macro s'éxécute et s'arrète comme si elle n'avait rien trouver sur le fichier réel.

Si quelqu'un a une solution, je vous en serait très reconnaissant.

A+

Bonjour

A part une erreur dans le code de la page

Il est sensé faire quoi ce code ?

Sinon la macro s'exécute bien

A suivre

Edit : Le code serait mieux dans un module

Re,

En faite je voudrais rechercher du contenu compris dans des zones de textes, la fonction ctrl+f de excel ne marche pas dans les zones de textes.

Le fichier ressemble au fichier joint dans mon précédent message, le seul truc est que le fichier réel contient environ 40 feuilles excel 30 graphique et 1000 zones de textes/feuilles. Ceci viendrait t'il de la?

Pour executer la macro, je l'ai affecter a un bouton personnaliser.

Merci d'avance.

Bonjour

J'ai fait un test en cherchant dans la 2ème page

Il me trouve bien zone de texte et la page

Après il fait des calculs pour se positionner dans la ....1ère page

Joins un fichier représentatif de ton fichier réel afin de mieux tester

A suivre

Re,

Voila le fichier réel qui bug, pour moi il me marque erreur n°13 incompatibilité de type la ligne qui bug est la numéro 14 apre avoir fait 11 boucle.

Merci d'avance

Bonjour

2 Bugs

Remplaces les parties correspondantes par celles-ci

   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 "*" & numOf & "*" Then trouve = True
            If trouve Then Exit For
        End If
        Next laShape
        If trouve Then Exit For
    Next laFeuille

    'calculer la cellule correspondante aux "coordonnées"
   Set celluleCentre = Sheets(1).Range("A1")

re Banzai64,

Merci pour ces 2 bugs corrigés.

Après un test sur un fichier un peu plus grand, la ligne 14 bug au bout de la 15eme boucle.

Est-il possible de faire ce type de recherche sur plus de 1000 boucles?

A+

Bonjour

A mon avis il ne doit pas y avoir de problème même si plus de 10000 formes

la ligne 14 bug au bout de la 15eme boucle.

15ème page ?

Envoies cette page pour vérifier

Bonjour,

Je t'ai écouter et j'ai mis la macro dans un module. elle se lance toujours à l'aide d'un bouton cliquable sur une barre d'outils personnalisé.

Je ne peut t'envoyer le fichier réel il est confidentiel.

Je l'ai tester c'est bien la 15eme boucle et pas la 15eme page.

Mes compétences en macro sont minimes, peut-être que je l'insère mal dans le document ou autre?

Merci d'avance.

Bonjour

A première vue tu n'as pas modifié la macro comme indiquée avant

Banzai64 a écrit :

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 "*" & numOf & "*" Then trouve = True

If trouve Then Exit For

End If

Next laShape

If trouve Then Exit For

Next laFeuille

Bonjour,

En effet je n'avais pas tout changer. Marche parfaitement même sur le fichier réel.

Merci beaucoup Banzai64!!!!