Discussion :

[ZeitnotZatopek]

Bonjour et merci d'avance

Dans une "inputbox" l'utilisateur donne un mot qui est cherché dans le classeur, puis la cellule entière est copiée sur une cellule qui elle ne change pas de place.

Cette partie du programme est faite.

je voudrais mettre en gras le mot demandé par l'utilisateur dont la position dans la cellule n'est donc jamais la même.

Est-ce possible?

merci

[Commodore]

Salut,

as-tu un bout de code stp ?

[ZeitnotZatopek]

justement je suis complètement bloqué....

[Commodore]

Quartier libre alors...

Bon, ben dans ce cas, voici ce que je suggère:

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
Sub recherche()
Dim response As String
Dim c As Range
 
response = InputBox("texte","titre")
 
For each c in Range("<la plage de recherche>")
    If c.Value Like "*" & response & "*" Then
        Range("<La cellule cible qui est toujours la même>").Value = c.Value
        'mettre en gras la cellule de destination
        Range("<La cellule cible qui est toujours la même>").Font.Bold = True
        'mettre en gras la cellule issue de la recherche
        c.Font.Bold = True
Next c
 
End Sub

'attention, avec cette méthode on recherche toutes les cellules qui contiennent le texte entré dans la InputBox
'Donc peut être plusieurs résultats dont seul le dernier sera copié dans la cellule de destination

[fring]

Bonjour tlm,

Juste un petit détail insignifiant qui deviendra très vite un gros détail

Ne pas oublier à chaque recherche de remettre la police de caractères des cellules sur un style normal sinon à chaque recherche, le mot trouvé se mettra en Gras et le restera ad vitam eternam

[ZeitnotZatopek]

merci Commodore_Psykopate

Ton programme marche, mais il met toute la cellule en gras, or je voudrais juste mettre le mot demandé en gras, j'ai finalement trouvé ce morceau de programme.
Mais, il met en gras plus que le mot en commençant pourtant au début.

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
 
 
Sub Gras()
 
On Error GoTo GE:
Dim feuille As Worksheet
Dim j, N As Integer
Dim A
Mot = "coucou"
Sheets(3).Select
 
j = Len(Mot)
 
Set feuille = Worksheets("Recherche par mots clés")
 
Cells(1, 7).Select
A = Cells(1, 7).Value
N = Application.Search(Mot, A, 1)
 
If N <> 0 Then
    With Worksheets(3).Cells(1, 7)
        .Characters(N, N + j).Font.Bold = True
    End With
End If
 
Exit Sub
 
GE:
 
MsgBox "Erreur N° " & Err.Number & " : " & Err.Description, vbExclamation
 
End Sub

[ZeitnotZatopek]

j'ai enfin trouvé grace au coup de pouce non négligeable de Commodore_Psykopate, 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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
Sub Gras()
 
On Error GoTo GE:
Dim feuille As Worksheet
Dim i, j, k, N As Integer
Dim c As Range
Dim A
 
Mot="coucou"
 
Sheets(3).Select
j = Len(Mot)
Set feuille = Worksheets("Recherche par mots clés")
Cells(12, 7).Select
Selection.End(xlDown).Select
k = ActiveCell.Row
i = 12
For Each c In Range(Cells(12, 7), Cells(k, 7))
 
 
    Cells(i, 7).Select
    If c.Value Like "*" & Mot & "*" Then
 
        A = Cells(i, 7).Value
        N = Application.Search(Mot, A, 1)
 
            If N <> 0 Then
 
                With Worksheets(3).Cells(i, 7)
                    .Characters(N, j).Font.Bold = True
                End With
 
            End If
 
    End If
 
i = i + 1
 
Next
 
Exit Sub
 
GE:
 
MsgBox "Erreur N° " & Err.Number & " : " & Err.Description, vbExclamation
 
End Sub