Discussion :

[declc]

Bonjour,
mon petit problème, j'aimerais que ce soit juste les lettres recherchées qui s'affiche en gras et rouge.
Si quelqu'un à une solution car ici cela me met les premiers caractères dans la cellule.
Par exemple si je recherche "SA" pour "SACS" il va me trouver ceci [BAG LPDE ( SACS PLASTIQUES) et me mettre "BA" en gras et rouge et j'aimerais que ce soit "SA".
Si quelqu'un peu m'aider, super
et un tout grand merci.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub RechercheEtCouleur(Mot As String)
Dim Rng As Range, Sht As Worksheet
Dim plage As Range, cel As Range
 
 
For Each Sht In ThisWorkbook.Sheets
    If Sht.Name <> "Recherche" Then
        Set plage = Sht.Range("B3").CurrentRegion 'range("B3") à changer par la bonne cellule de départ
        For Each cel In plage
            If cel Like "*" & Mot & "*" Then
 
                With cel.Characters(Start:=InStr(1, Selection, Left(Mot, 1), 1), Length:=Len(Mot))
                .Font.ColorIndex = 3 'colorie en rouge
                .Font.Bold = True 'met en gras
                End With
                Sht.Activate: cel.Activate
                If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
                    Cells.Font.ColorIndex = 0 'remise de la couleur noire
                    Cells.Font.Bold = False 'enlever le gras
                    Exit Sub
                Else: Sheets("Recherche").Activate
 
                End If
 
            End If
        Next cel
        For Each cel In plage
            cel.Font.ColorIndex = 0 'remise de la couleur noire
            cel.Font.Bold = False 'enlever le gras
        Next cel
    End If
Next Sht
MsgBox "Il n'y a pas d'autres résultats", vbInformation, "Information"
End Sub

[Daniel.C]

Bonjour,

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub RechercheEtCouleur(Mot As String)
    Dim Rng As Range, Sht As Worksheet
    Dim plage As Range, cel As Range
 
 
    For Each Sht In ThisWorkbook.Sheets
        If Sht.Name <> "Recherche" Then
            Set plage = Sht.Range("B3").CurrentRegion 'range("B3") à changer par la bonne cellule de départ
            For Each cel In plage
                If cel Like "*" & Mot & "*" Then
 
                    With cel.Characters(Start:=InStr(1, cel.Value, Mot), Length:=Len(Mot))
                        .Font.ColorIndex = 3 'colorie en rouge
                        .Font.Bold = True 'met en gras
                    End With
                    Sht.Activate: cel.Activate
                    If MsgBox("Poursuivre recherche ?", vbYesNo) = vbNo Then
                        Cells.Font.ColorIndex = 0 'remise de la couleur noire
                        Cells.Font.Bold = False 'enlever le gras
                        Exit Sub
                    Else: Sheets("Recherche").Activate
 
                    End If
 
                End If
            Next cel
            For Each cel In plage
                cel.Font.ColorIndex = 0 'remise de la couleur noire
                cel.Font.Bold = False 'enlever le gras
            Next cel
        End If
    Next Sht
    MsgBox "Il n'y a pas d'autres résultats", vbInformation, "Information"
End Sub

[declc]

Un tout grand merci Daniel. Cela fonctionne super et c'étais si simple, depuis le temps que je cherche.

A plus

Christophe