Recherche de mot dans des commentaires

michel.dupont

XLDnaute Occasionnel
Bonjour
je voudrais créer un fichier de réservation de véhicule pour une institution pour personnes handicapées.Dans certaines cellules seront mis en commentaires (je parle bien des commentaires qui marque la cellule d'un petit triangle rouge) le nom de la destination c'est à dire une ville....
j'ai tenté d'écrire deux macros de recherche dans les commentaires qui me renvoient (hélas) des messages d'erreurs...
je voudrais en plus écrire une macro pour rechercher un mot dans les commentaires , mot qu'on encoderait dans une message box et qui colorise la cellule contenant le commentaire où se trouve le mot précisé dans la dite message box.
Je joins mon petit fichier qui donc ne fonctionne pas....
merci de votre aide
Michel
 

Pièces jointes

  • recherche com.xlsm
    21.5 KB · Affichages: 9

job75

XLDnaute Barbatruc
Bonsoir michel.dupont,
VB:
Sub ListeCommentaires()
Dim a(), c As Comment, n&
With Feuil1 'CodeName
    ReDim a(1 To .Comments.Count + 1, 1 To 3) 'tableau, plus rapide
    a(1, 1) = "Adresse": a(1, 2) = "Texte"
    n = 1
    For Each c In .Comments
        n = n + 1
        a(n, 1) = c.Parent.Address(0, 0)
        a(n, 2) = c.Text
        a(n, 3) = c.Parent.Row
    Next
End With
'---restitution---
Application.ScreenUpdating = False
With Feuil2 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].Resize(n, 3)
        .Value = a
        .Sort .Columns(3), xlAscending, Header:=xlYes 'tri sur la 3ème colonne
        .Columns(3).Delete xlToLeft
        .Offset(n).Resize(.Parent.Rows.Count - n).Delete xlUp 'RAZ dessous
    End With
    .Activate 'facultatif
End With
End Sub
Code:
Sub ChercheCommentaires()
Dim ValCherchée$, c As Comment
ValCherchée = "libramont"
Application.ScreenUpdating = False
With Feuil1 'CodeName
    .Cells.Interior.ColorIndex = xlNone 'RAZ
    For Each c In .Comments
        If InStr(c.Text, ValCherchée) Then c.Parent.Interior.ColorIndex = 4
    Next
End With
End Sub
A+
 

cathodique

XLDnaute Accro
un grand merci JOB 75
ces 2 codes fonctionnent parfaitement !
Peux-tu me donner un coup de pouce à partir du second code (chercherCommentaires) pour introduire le mot recherché via une messagebox.
Amicalement
Michel
Bonjour,
Comme ceci
VB:
ValCherchée= InputBox("Compléter Valeur à rechercher:", "Recherche Valeur")
Bonne journée.
 

job75

XLDnaute Barbatruc
Bonjour michel.dupont, cathodique,

Il faut se fatiguer un peu plus :
VB:
Sub ChercheCommentaires()
Dim ValCherchée$, c As Comment
Do
    ValCherchée = InputBox("Valeur cherchée :", "Recherche", ValCherchée)
    If ValCherchée = "" Then Exit Do
    With Feuil1 'CodeName
        If .Cells.Find(ValCherchée, , xlComments, xlPart) Is Nothing Then
            MsgBox "Ce texte n'existe pas dans les commentaires..."
        Else
            Application.ScreenUpdating = False
            .Cells.Interior.ColorIndex = xlNone 'RAZ
            For Each c In .Comments
                If InStr(UCase(c.Text), UCase(ValCherchée)) Then c.Parent.Interior.ColorIndex = 4
            Next
            Exit Do
        End If
    End With
Loop
End Sub
Edit : j'ai complété avec UCase pour que la casse soit ignorée.

A+
 
Dernière édition:

michel.dupont

XLDnaute Occasionnel
Bonjour michel.dupont, cathodique,

Il faut se fatiguer un peu plus :
VB:
Sub ChercheCommentaires()
Dim ValCherchée$, c As Comment
Do
    ValCherchée = InputBox("Valeur cherchée :", "Recherche", ValCherchée)
    If ValCherchée = "" Then Exit Do
    With Feuil1 'CodeName
        If .Cells.Find(ValCherchée, , xlComments, xlPart) Is Nothing Then
            MsgBox "Ce texte n'existe pas dans les commentaires..."
        Else
            Application.ScreenUpdating = False
            .Cells.Interior.ColorIndex = xlNone 'RAZ
            For Each c In .Comments
                If InStr(UCase(c.Text), UCase(ValCherchée)) Then c.Parent.Interior.ColorIndex = 4
            Next
            Exit Do
        End If
    End With
Loop
End Sub
Edit : j'ai complété avec UCase pour que la casse soit ignorée.

A+
parfait un tout grand merci
Michel
 
Haut Bas