[FAQ][Characters] Mettre en évidence un mot [FAQ]

[cafeine]

Hello,

Un exemple de code pour mettre en évidence un mot sur une plage de cellules afin d'illustrer l'utilisation de Characters.

Utilisation

Code :

highlightword   "gestion", Range("A1:A30")

Code :

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
35
Option Explicit
 
Public Sub HighlightWord(ByVal str As String, r As Range)
 
    Dim res As Range
    Dim firstAddress As String, pos As Long
 
    ' on fait une recherche sur la plage
    With r.Cells
        Set res = .Find(What:=str, After:=r.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 
        If Not res Is Nothing Then
            firstAddress = res.Address
            Do
                pos = InStr(res.Value, str)
                Do While pos > 0
                    With res.Characters(pos, Len(str))
                        'ici on mettra en gras rouge
                        .Font.Color = vbRed
                        .Font.Bold = True
                    End With
                    pos = InStr(pos + 1, res.Value, str)
                Loop
                Set res = .Find(What:=str, After:=res, LookIn:=xlFormulas _
                        , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With
 
    Set res = Nothing
 
End Sub

[Many31]

Sympat.. merki ca aide

je me suis permis de rajouter une sub pour appuyer ta fonction (en mettant cells pour la plage de recherche) car au final j'ai sauté sur l'occasion pour en faire un tit outil de recherche

Code :

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Option Explicit
Dim vTempo As Boolean
Public collection
 
Sub GetTempo()
 
    If [sheet3!A2] = "" Then
    vTempo = Not vTempo
    Application.OnTime Now + TimeValue("00:00:01"), "GetTempo"
 
        If vTempo = True Then
            Range(collection).Interior.ColorIndex = 36
        Else
            Range(collection).Interior.ColorIndex = xlNone
        End If
    Else
    Range(collection).Interior.ColorIndex = xlNone
    End If
End Sub
 
Sub Macro222()
Call HighlightWord("dede", Cells)
End Sub
 
 
Public Sub HighlightWord(ByVal str As String, r As Range)
 
    Dim res As Range
    Dim firstAddress As String, pos As Long
 
    collection = ""
 
    ' on fait une recherche sur la plage
    With r.Cells
        Set res = .Find(What:=str, After:=r.Cells(1, 1), LookIn:=xlFormulas _
            , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
 
        If Not res Is Nothing Then
            firstAddress = res.Address
 
            Do
 
                pos = InStr(res.Value, str)
                Do While pos > 0
                    With res.Characters(pos, Len(str))
                        'ici on mettra en gras rouge
                        .Font.Color = vbRed
                        .Font.Bold = True
                    End With
                    pos = InStr(pos + 1, res.Value, str)
                Loop
                collection = collection & "," & res.Address
                Set res = .Find(What:=str, After:=res, LookIn:=xlFormulas _
                        , LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)
            Loop While Not res Is Nothing And res.Address <> firstAddress
        End If
    End With
    collection = Right(collection, Len(collection) - 1)
    Set res = Nothing
    If collection <> "" Then Call GetTempo
End Sub

qui me permet donc de faire "clignoter" les cellules qui contienne le mot recherché (par contre j'ai fixé arbitrairement le fait que la cellule B2 de ma feuille arrétait l'éxecution du code... sinon ca sarrete jamais -_-' )