Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Mettre en "Gras" une partie de texte trouvée avec ".Find"

3 réponses
Avatar
Syl
Bonjour!

Voici mon probl=E8me, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouv=E9e
en Gras. Pr=E9sentement j'utilise le code "c.font.bold =3D True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit appara=EEtre en gras c'est seulement la chaine de
caract=E8res qui se trouve dans la variable txtAppareil.Value.


'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au crit=E8re
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c =3D .Find(txtAppareil.Value, LookIn:=3DxlValues)
If Not c Is Nothing Then
FirstAddress =3D c.Address
j =3D 0
Do
j =3D j + 1
myArray(j, 1) =3D c.Address
c.font.bold =3D True
'Debug.Print myArray(j, 1)
Set c =3D .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With


Merci.

3 réponses

Avatar
Xavier POWAGA
voici une autre solution avec la fonction RegExp


Sub EncadreMot()
On Error Resume Next

Dim RE As Object, Matches As Object
Dim match As Object, c As Range
Set RE = New RegExp
RE.Pattern = TextRecherche
RE.Global = True
RE.IgnoreCase = False
Set Matches = RE.Execute(Cells(ligne,colonne).Value)
If Matches.Count > 0 Then
For Each match In Matches
Cells(ligne,colonne).Characters(Start:=match.FirstIndex + 1,
Length:=match.Length).Font.FontStyle = "Gras"
Next
End If
Next


End Sub
"Syl" a écrit dans le message de news:

Bonjour!

Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.


'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With


Merci.
Avatar
michdenis
Bonjour Syl,

'-------------------------------
Sub test()

Dim C As Range, L As Integer
Dim J As Integer
With KBB
With .Range("A3:A" & .Range("E65000").End(xlUp).Row)
Set C = .Find(txtAppareil.Value, LookIn:=xlValues)
L = Len(Trim(txtAppareil.Value))
If Not C Is Nothing Then
FirstAddress = C.Address
J = 0
Do
J = J + 1
MyArray(J, 1) = C.Address
C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
'pour copier la liste des adresse vers la cellule G1 de la présente feuille.
On Error Resume Next
.Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray)
End With
End Sub
'-------------------------------


Salutations!




"Syl" a écrit dans le message de news:
Bonjour!

Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.


'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With


Merci.
Avatar
michdenis
Bonjour Syl,

Je ne t'ai pas envoyé la procédure corrigée...
la voici !

'------------------------------
Sub test()

Dim C As Range, L As Integer
Dim J As Long, FirstAddress As String
Dim MyArray()

With KBB
With .Range("A3:A" & .Range("E65000").End(xlUp).Row)
Set C = .Find(txtAppareil.Value, LookIn:=xlValues)
L = Len(Trim(txtAppareil.Value))
If Not C Is Nothing Then
FirstAddress = C.Address
J = 1
Do
ReDim Preserve MyArray(1 To 1, 1 To J)
MyArray(1, J) = C.Address
C.Characters(InStr(1, C, "toto", vbTextCompare), L).Font.Bold = True
J = J + 1
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress
End If
End With
'pour copier la liste des adresse vers la cellule G1 de la présente feuille.
On Error Resume Next
.Range("g1").Resize(UBound(MyArray, 2)) = Application.Transpose(MyArray)
End With
End Sub
'------------------------------


Salutations!




"Syl" a écrit dans le message de news:
Bonjour!

Voici mon problème, je fais une recherche dans du texte avec la
fonction .Find par la suite je doit mettre la partie de texte trouvée
en Gras. Présentement j'utilise le code "c.font.bold = True" mais ceci
met le contenu de toute la cellule en gras.
Ce qui doit apparaître en gras c'est seulement la chaine de
caractères qui se trouve dans la variable txtAppareil.Value.


'Enregistre dans la variable tableau les adresses de tous les
enregistrement qui
'correspondent au critère
With KBB.Range("A3:A" & KBB.Range("E65000").End(xlUp).Row)
Set c = .Find(txtAppareil.Value, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
j = 0
Do
j = j + 1
myArray(j, 1) = c.Address
c.font.bold = True
'Debug.Print myArray(j, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With


Merci.